PowerDesigner 数据库设计导出到Excel
2016-01-14 14:55
411 查看
代码一:所有的表在同一个 Sheet 页中
'****************************************************************************** '* File: pdm2excel.txt '* Title: pdm export to excel '* Purpose: To export the tables and columns to Excel '* Model: Physical Data Model '* Objects: Table, Column, View '* Author: ziyan '* Created: 2012-05-03 '* Version: 1.0 '****************************************************************************** Option Explicit Dim rowsNum rowsNum = 0 '----------------------------------------------------------------------------- ' Main function '----------------------------------------------------------------------------- ' Get the current active model Dim Model Set Model = ActiveModel If (Model Is Nothing) Or (Not Model.IsKindOf(PdPDM.cls_Model)) Then MsgBox "The current model is not an PDM model." Else ' Get the tables collection '创建EXCEL APP dim beginrow DIM EXCEL, SHEET set EXCEL = CREATEOBJECT("Excel.Application") EXCEL.workbooks.add(-4167)'添加工作表 EXCEL.workbooks(1).sheets(1).name ="test" set sheet = EXCEL.workbooks(1).sheets("test") ShowProperties Model, SHEET EXCEL.visible = true '设置列宽和自动换行 sheet.Columns(1).ColumnWidth = 20 sheet.Columns(2).ColumnWidth = 40 sheet.Columns(4).ColumnWidth = 20 sheet.Columns(5).ColumnWidth = 20 sheet.Columns(6).ColumnWidth = 15 sheet.Columns(1).WrapText =true sheet.Columns(2).WrapText =true sheet.Columns(4).WrapText =true End If '----------------------------------------------------------------------------- ' Show properties of tables '----------------------------------------------------------------------------- Sub ShowProperties(mdl, sheet) ' Show tables of the current model/package rowsNum=0 beginrow = rowsNum+1 ' For each table output "begin" Dim tab For Each tab In mdl.tables ShowTable tab,sheet Next if mdl.tables.count > 0 then sheet.Range("A" & beginrow + 1 & ":A" & rowsNum).Rows.Group end if output "end" End Sub '----------------------------------------------------------------------------- ' Show table properties '----------------------------------------------------------------------------- Sub ShowTable(tab, sheet) If IsObject(tab) Then Dim rangFlag rowsNum = rowsNum + 1 ' Show properties Output "================================" sheet.cells(rowsNum, 1) = "实体名" sheet.cells(rowsNum, 2) =tab.name sheet.cells(rowsNum, 3) = "" sheet.cells(rowsNum, 4) = "表名" sheet.cells(rowsNum, 5) = tab.code sheet.Range(sheet.cells(rowsNum, 5),sheet.cells(rowsNum, 6)).Merge rowsNum = rowsNum + 1 sheet.cells(rowsNum, 1) = "属性名" sheet.cells(rowsNum, 2) = "说明" sheet.cells(rowsNum, 3) = "" sheet.cells(rowsNum, 4) = "字段中文名" sheet.cells(rowsNum, 5) = "字段名" sheet.cells(rowsNum, 6) = "字段类型" '设置边框 sheet.Range(sheet.cells(rowsNum-1, 1),sheet.cells(rowsNum, 2)).Borders.LineStyle = "1" sheet.Range(sheet.cells(rowsNum-1, 4),sheet.cells(rowsNum, 6)).Borders.LineStyle = "1" Dim col ' running column Dim colsNum colsNum = 0 for each col in tab.columns rowsNum = rowsNum + 1 colsNum = colsNum + 1 sheet.cells(rowsNum, 1) = col.name sheet.cells(rowsNum, 2) = col.comment sheet.cells(rowsNum, 3) = "" sheet.cells(rowsNum, 4) = col.name sheet.cells(rowsNum, 5) = col.code sheet.cells(rowsNum, 6) = col.datatype next sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,2)).Borders.LineStyle = "2" sheet.Range(sheet.cells(rowsNum-colsNum+1,4),sheet.cells(rowsNum,6)).Borders.LineStyle = "2" rowsNum = rowsNum + 1 Output "FullDescription: " + tab.Name End If End Sub
代码二:每个表都会新建一个 Sheet 页,第一个 Sheet 页上是所有表的列表
'****************************************************************************** '* File: pdm2excel.txt '* Title: pdm export to excel '* Purpose: To export the tables and columns to Excel '* Model: Physical Data Model '* Objects: Table, Column, View '* Author: Chirs '* Created: 2015-01-28 '* Version: 1.0 '****************************************************************************** Option Explicit Dim rowsNum rowsNum = 0 '----------------------------------------------------------------------------- ' Main function '----------------------------------------------------------------------------- ' Get the current active model Dim Model Set Model = ActiveModel If (Model Is Nothing) Or (Not Model.IsKindOf(PdPDM.cls_Model)) Then MsgBox "The current model is not an PDM model." Else ' Get the tables collection '创建EXCEL APP Dim beginrow Dim EXCEL, BOOK, SHEET Set EXCEL = CreateObject("Excel.Application") EXCEL.Visible = True Set BOOK = EXCEL.Workbooks.Add(-4167) '新建工作簿 BOOK.Sheets(1).Name = "数据库表结构" Set SHEET = EXCEL.workbooks(1).sheets("数据库表结构") ShowProperties Model, SHEET EXCEL.visible = true '设置列宽和自动换行 SHEET.Columns(1).ColumnWidth = 10 SHEET.Columns(2).ColumnWidth = 30 SHEET.Columns(3).ColumnWidth = 20 SHEET.Columns(1).WrapText =true SHEET.Columns(2).WrapText =true SHEET.Columns(3).WrapText =true End If '----------------------------------------------------------------------------- ' Show properties of tables '----------------------------------------------------------------------------- Sub ShowProperties(mdl, sheet) ' Show tables of the current model/package rowsNum=0 beginrow = rowsNum+1 ' For each table output "begin" Dim tab For Each tab In mdl.tables ShowTable tab,sheet Next if mdl.tables.count > 0 then sheet.Range("A" & beginrow + 1 & ":A" & rowsNum).Rows.Group end if output "end" End Sub '----------------------------------------------------------------------------- ' 数据表查询 '----------------------------------------------------------------------------- Sub ShowTable(tab, sheet) If IsObject(tab) Then Dim rangFlag sheet.cells(1, 1) = "序号" sheet.cells(1, 2) = "表名" sheet.cells(1, 3) = "实体名" '设置边框 sheet.Range(sheet.cells(1, 1),sheet.cells(1, 3)).Borders.LineStyle = "1" '设置背景颜色 sheet.Range(sheet.cells(1, 1),sheet.cells(1, 3)).Interior.ColorIndex = "19" rowsNum = rowsNum + 1 sheet.cells(rowsNum+1, 1) = rowsNum sheet.cells(rowsNum+1, 2) = tab.code sheet.cells(rowsNum+1, 3) = tab.name '设置边框 sheet.Range(sheet.cells(rowsNum+1,1),sheet.cells(rowsNum+1,3)).Borders.LineStyle = "2" '增加Sheet BOOK.Sheets.Add , BOOK.Sheets(BOOK.Sheets.count) BOOK.Sheets(rowsNum+1).Name = tab.code Dim shtn Set shtn = EXCEL.workbooks(1).sheets(tab.code) '设置列宽和换行 shtn.Columns(1).ColumnWidth = 30 shtn.Columns(2).ColumnWidth = 20 shtn.Columns(3).ColumnWidth = 20 shtn.Columns(5).ColumnWidth = 30 shtn.Columns(6).ColumnWidth = 20 shtn.Columns(1).WrapText =true shtn.Columns(2).WrapText =true shtn.Columns(3).WrapText =true shtn.Columns(5).WrapText =true shtn.Columns(6).WrapText =true '设置列标题 shtn.cells(1, 1) = "字段中文名" shtn.cells(1, 2) = "字段名" shtn.cells(1, 3) = "字段类型" shtn.cells(1, 5) = tab.code shtn.cells(1, 6) = tab.Name '设置边框 shtn.Range(shtn.cells(1, 1),shtn.cells(1, 3)).Borders.LineStyle = "1" shtn.Range(shtn.cells(1, 5),shtn.cells(1, 6)).Borders.LineStyle = "1" '设置背景颜色 shtn.Range(shtn.cells(1, 1),shtn.cells(1, 3)).Interior.ColorIndex = "19" shtn.Range(shtn.cells(1, 5),shtn.cells(1, 6)).Interior.ColorIndex = "19" Dim col ' running column Dim colsNum Dim rNum colsNum = 0 rNum = 0 for each col in tab.columns rNum = rNum + 1 colsNum = colsNum + 1 shtn.cells(rNum+1, 1) = col.name shtn.cells(rNum+1, 2) = col.code shtn.cells(rNum+1, 3) = col.datatype next shtn.Range(shtn.cells(rNum-colsNum+2,1),shtn.cells(rNum+1,3)).Borders.LineStyle = "2" rNum = rNum + 1 Output "FullDescription: " + tab.Name End If End Sub
相关文章推荐
- Android之获取手机上的图片和视频缩略图thumbnails
- 使用Python生成Excel格式的图片
- 数据库链接字符串查询网站
- PowerDesigner 面向对象模型(OOM)说明
- Excel 曝出 Power Query 安全漏洞,1.2 亿用户易受远程 DDE 攻击
- DB2实例管理
- DB2实例管理
- 保障MySQL数据安全的14个最佳方法
- mysql问答汇集
- VBA将excel数据表生成JSON文件
- excel vba 限制工作表的滚动区域代码
- excel vba 高亮显示当前行代码
- 创建一个空的IBM DB2 ECO数据库的方法
- Access 2000 数据库 80 万记录通用快速分页类
- 开通一个数据库失败的原因的和解决办法
- 一个简单的asp数据库操作类
- CentOS下DB2数据库安装过程详解
- EasyASP v1.5发布(包含数据库操作类,原clsDbCtrl.asp)第1/2页
- sql2008 还原数据库解决方案