PDM转Excel
- 使用了VBS+Powder Designer实现
- 基本功能如下:
- 支持每个表一个sheet页
- 支持目录索引
- 支持每个sheet页返回目录
- 支持索引
- 支持主键
增强版见:https://blog.csdn.net/u011461385/article/details/88815235
- 步骤如下:
- PD中使用Ctrl+Shift+X获取脚本执行窗口
- 拷贝以下代码置窗口中
Option Explicit Dim mdl Set mdl = ActiveModel If (mdl Is Nothing) Then MsgBox "There is no Active Model" End If Dim EXCEL, SheetList Set EXCEL = CreateObject("Excel.Application") EXCEL.Visible = True EXCEL.Workbooks.Add Dim tab Dim sheet For Each tab In mdl.tables EXCEL.workbooks(1).sheets.add EXCEL.workbooks(1).sheets(1).name = tab.code set sheet = EXCEL.workbooks(1).sheets(tab.code) EXCEL.visible = true sheet.Columns(1).ColumnWidth = 25 sheet.Columns(2).ColumnWidth = 20 sheet.Columns(3).ColumnWidth = 15 sheet.Columns(4).ColumnWidth = 7 sheet.Columns(5).ColumnWidth = 7 sheet.Columns(6).ColumnWidth = 10 sheet.Columns(7).ColumnWidth = 60 sheet.Columns(1).WrapText =true sheet.Columns(2).WrapText =true sheet.Columns(4).WrapText =true EXCEL.ActiveWindow.DisplayGridlines = False Next EXCEL.workbooks(1).sheets.add EXCEL.workbooks(1).sheets(1).name ="目录" set SheetList = EXCEL.workbooks(1).sheets("目录") ShowTableList mdl, SheetList CreateTab mdl, SheetList Sub CreateTab(mdl, SheetList) Dim rowsNum, tablecode, tablname rowsNum = 0 For Each tab In mdl.tables rowsNum = 1 set SHEET = EXCEL.workbooks(1).sheets(tab.code) sheet.cells(rowsNum, 1) = "表中文名" tablecode = tab.code tablname = tab.name tablname = replace(tablname, tablecode, "") sheet.cells(rowsNum, 2) = tablname sheet.cells(rowsNum, 3) = "表英文名" sheet.cells(rowsNum, 4) = tab.code sheet.Range(sheet.cells(rowsNum, 4),sheet.cells(rowsNum, 6)).Merge sheet.cells(rowsNum, 7) = "返回目录" sheet.Hyperlinks.Add sheet.cells(rowsNum,7), "","目录"&"!B"&rowsNum rowsNum = rowsNum + 1 sheet.cells(rowsNum, 1) = "表中文说明" sheet.cells(rowsNum, 2) = tab.name sheet.Range(sheet.cells(rowsNum, 2),sheet.cells(rowsNum, 7)).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.cells(rowsNum, 7) = "字段说明" addTabsCol sheet, tab, rowsNum addTabsidx sheet, tab, rowsNum addTabPK sheet, tab, rowsNum sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).Borders.LineStyle = "1" sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).Font.Size=10 sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).Font.Name="微软雅黑" sheet.Range(sheet.cells(1, 1),sheet.cells(3, 7)).Interior.colorindex = "3" sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).RowHeight = "21" sheet.Range(sheet.cells(1, 1),sheet.cells(3, 7)).Font.Bold = True sheet.Range(sheet.cells(3, 7),sheet.cells(rowsNum, 7)) = " " Next End Sub Sub addTabsCol(sheet, tab, rowsNum) Dim col Dim colsNum colsNum = 0 for each col in tab.columns rowsNum = rowsNum + 1 colsNum = colsNum + 1 sheet.cells(rowsNum, 1) = col.code sheet.cells(rowsNum, 2) = col.name sheet.cells(rowsNum, 3) = col.datatype If col.Mandatory = true Then sheet.cells(rowsNum, 4) = "非空" Else sheet.cells(rowsNum, 4) = " " End If sheet.cells(rowsNum, 5) = col.DefaultValue sheet.cells(rowsNum, 7) = col.comment Next End Sub Sub addTabsidx(sheet, tab, rowsNum) rowsNum = rowsNum + 1 sheet.cells(rowsNum, 1) = "索引名" sheet.cells(rowsNum, 2) = "索引类型" sheet.cells(rowsNum, 3) = "索引列表" sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Merge sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 7)).Font.Bold = True Dim index Dim idxNm Dim indexstrlst idxNm = 0 for each index in tab.indexes rowsNum = rowsNum + 1 idxNm = idxNm + 1 sheet.cells(rowsNum, 1) = index.code if index.unique = "1" Then sheet.cells(rowsNum, 2) = "UNIQUE" Else sheet.cells(rowsNum, 2) = "NORM" End If Dim keystr Dim indexcol keystr = "" for each indexcol in index.IndexColumns keystr = keystr +","+ indexcol.code next keystr = mid(keystr, 2, len(keystr)) sheet.cells(rowsNum, 3) = keystr sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Merge next End Sub Sub addTabPK(sheet, tab, rowsNum) Dim key Dim keyNm Dim keystr Dim flag Dim keycode Dim keycol rowsNum = rowsNum + 1 sheet.cells(rowsNum, 1) = "主键" sheet.cells(rowsNum, 2) = "索引类型" sheet.cells(rowsNum, 3) = "主键列表" sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Merge sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 7)).Font.Bold = True for each key in tab.keys keycode = key.code if key.Primary = true Then flag = 1 keystr = "" for each keycol in key.columns keystr = keystr +","+ keycol.code next keystr = mid(keystr, 2, len(keystr)) End If next if flag = 1 Then rowsNum = rowsNum + 1 keyNm = 1 'sheet.cells(rowsNum, 1) = keycode sheet.cells(rowsNum, 1) = "PK_"+tab.code sheet.cells(rowsNum, 2) = "UNIQUE" sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Merge sheet.cells(rowsNum, 3) = keystr End If End Sub Sub ShowTableList(mdl, SheetList) Dim rowsNum rowsNum=1 SheetList.cells(rowsNum, 1) = "主题" SheetList.cells(rowsNum, 2) = "表中文名" SheetList.cells(rowsNum, 3) = "表英文名" SheetList.cells(rowsNum, 4) = "表说明" SheetList.Columns(1).ColumnWidth = 20 SheetList.Columns(2).ColumnWidth = 30 SheetList.Columns(3).ColumnWidth = 35 SheetList.Columns(4).ColumnWidth = 70 rowsNum = rowsNum + 1 SheetList.cells(rowsNum, 1) = mdl.name Dim tab For Each tab In mdl.tables If IsObject(tab) Then rowsNum = rowsNum + 1 SheetList.cells(rowsNum, 1) = "" SheetList.cells(rowsNum, 2) = replace(tab.name, tab.code, "") SheetList.cells(rowsNum, 3) = tab.code SheetList.cells(rowsNum, 4) = tab.comment sheetList.Hyperlinks.Add sheetList.cells(rowsNum,3), "",tab.code&"!B1" sheetList.Hyperlinks.Add sheetList.cells(rowsNum,2), "",tab.code&"!B1" End If Next SheetList.Range(SheetList.cells(1, 1),SheetList.cells(rowsNum, 4)).Borders.LineStyle = "1" SheetList.Range(SheetList.cells(1, 1),SheetList.cells(rowsNum, 4)).Font.Size=10 SheetList.Range(SheetList.cells(1, 1),SheetList.cells(rowsNum, 4)).Font.Name="微软雅黑" SheetList.Range(SheetList.cells(1, 1),SheetList.cells(1, 4)).Interior.colorindex = "3" SheetList.Range(SheetList.cells(1, 1),SheetList.cells(rowsNum, 4)).RowHeight = "20" SheetList.Range(SheetList.cells(1, 1),SheetList.cells(1, 4)).Font.Bold = True SheetList.Range(SheetList.cells(2, 1),SheetList.cells(rowsNum, 3)).Font.Bold = True SheetList.Range(SheetList.cells(1, 5),SheetList.cells(rowsNum, 5)) = " " EXCEL.ActiveWindow.DisplayGridlines = False End Sub
- 点击run
- 喝杯咖啡等待结果
- 效果如下
- 目录效果
- 表效果:
- 备注:
- 暂未支持PD中package,不过也可以手工处理下pdm文件,具体可私聊
- 颜色搭配来源于一个没办法盘
的客户(扶额) - 颜色懒的改脚本的人就就就手工改一下吧
- 为啥没写注释?懒+VBS有现成的用就成了,学了也没用