pdm转excel-超级豪华版

本文主要是介绍pdm转excel-超级豪华版，希望对大家解决编程问题提供一定的参考价值，需要的开发者们随着小编来一起学习吧！

PDM转Excel

• 使用了VBS+Powder Designer实现
• 基本功能如下：

1. 支持每个表一个sheet页
2. 支持目录索引
3. 支持每个sheet页返回目录
4. 支持索引
5. 支持主键

增强版见：https://blog.csdn.net/u011461385/article/details/88815235

• 步骤如下：

1. PD中使用Ctrl+Shift+X获取脚本执行窗口
2. 拷贝以下代码置窗口中

   
   Option ExplicitDim mdl 
   Set mdl = ActiveModel
   If (mdl Is Nothing) ThenMsgBox "There is no Active Model"
   End If
   Dim EXCEL, SheetList
   Set EXCEL = CreateObject("Excel.Application") 
   EXCEL.Visible = True 
   EXCEL.Workbooks.AddDim tab 
   Dim sheet  
   For Each tab In mdl.tablesEXCEL.workbooks(1).sheets.addEXCEL.workbooks(1).sheets(1).name = tab.codeset sheet = EXCEL.workbooks(1).sheets(tab.code)EXCEL.visible = truesheet.Columns(1).ColumnWidth = 25sheet.Columns(2).ColumnWidth = 20sheet.Columns(3).ColumnWidth = 15sheet.Columns(4).ColumnWidth = 7sheet.Columns(5).ColumnWidth = 7sheet.Columns(6).ColumnWidth = 10sheet.Columns(7).ColumnWidth = 60sheet.Columns(1).WrapText =truesheet.Columns(2).WrapText =truesheet.Columns(4).WrapText =trueEXCEL.ActiveWindow.DisplayGridlines = FalseNextEXCEL.workbooks(1).sheets.addEXCEL.workbooks(1).sheets(1).name ="目录"set SheetList = EXCEL.workbooks(1).sheets("目录")ShowTableList mdl, SheetListCreateTab mdl, SheetListSub CreateTab(mdl, SheetList)Dim rowsNum, tablecode, tablnamerowsNum = 0For Each tab In mdl.tablesrowsNum = 1set SHEET = EXCEL.workbooks(1).sheets(tab.code)sheet.cells(rowsNum, 1) = "表中文名"tablecode = tab.codetablname = tab.nametablname = replace(tablname, tablecode, "")sheet.cells(rowsNum, 2) = tablnamesheet.cells(rowsNum, 3) = "表英文名"sheet.cells(rowsNum, 4) = tab.codesheet.Range(sheet.cells(rowsNum, 4),sheet.cells(rowsNum, 6)).Mergesheet.cells(rowsNum, 7) = "返回目录"sheet.Hyperlinks.Add sheet.cells(rowsNum,7), "","目录"&"!B"&rowsNumrowsNum = rowsNum + 1sheet.cells(rowsNum, 1) = "表中文说明"sheet.cells(rowsNum, 2) = tab.namesheet.Range(sheet.cells(rowsNum, 2),sheet.cells(rowsNum, 7)).MergerowsNum = rowsNum + 1sheet.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, rowsNumaddTabsidx sheet, tab, rowsNumaddTabPK sheet, tab, rowsNumsheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).Borders.LineStyle = "1"sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).Font.Size=10sheet.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 = Truesheet.Range(sheet.cells(3, 7),sheet.cells(rowsNum, 7)) = " "NextEnd SubSub addTabsCol(sheet, tab, rowsNum)Dim col Dim colsNumcolsNum = 0for each col in tab.columnsrowsNum = rowsNum + 1colsNum = colsNum + 1sheet.cells(rowsNum, 1) = col.codesheet.cells(rowsNum, 2) = col.namesheet.cells(rowsNum, 3) = col.datatypeIf col.Mandatory = true Thensheet.cells(rowsNum, 4) = "非空" Elsesheet.cells(rowsNum, 4) = " " End Ifsheet.cells(rowsNum, 5) = col.DefaultValuesheet.cells(rowsNum, 7) =  col.commentNext 
   End Sub    Sub addTabsidx(sheet, tab, rowsNum)rowsNum = rowsNum + 1sheet.cells(rowsNum, 1) = "索引名"sheet.cells(rowsNum, 2) = "索引类型"sheet.cells(rowsNum, 3) = "索引列表"sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Mergesheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 7)).Font.Bold = TrueDim index Dim idxNmDim indexstrlst  idxNm = 0for each index in tab.indexesrowsNum = rowsNum + 1idxNm = idxNm + 1sheet.cells(rowsNum, 1) = index.codeif index.unique = "1" Thensheet.cells(rowsNum, 2) = "UNIQUE"Elsesheet.cells(rowsNum, 2) = "NORM"End IfDim keystrDim indexcolkeystr = ""for each indexcol in index.IndexColumnskeystr = keystr +","+ indexcol.codenextkeystr = mid(keystr, 2, len(keystr))sheet.cells(rowsNum, 3) = keystrsheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Mergenext
   End Sub Sub addTabPK(sheet, tab, rowsNum)Dim keyDim keyNmDim keystrDim flagDim keycodeDim keycolrowsNum = rowsNum + 1sheet.cells(rowsNum, 1) = "主键"sheet.cells(rowsNum, 2) = "索引类型"sheet.cells(rowsNum, 3) = "主键列表"sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Mergesheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 7)).Font.Bold = True for each key in tab.keyskeycode = key.codeif key.Primary = true Thenflag = 1keystr = ""for each keycol in key.columnskeystr = keystr +","+ keycol.codenextkeystr = mid(keystr, 2, len(keystr))End Ifnextif flag = 1 ThenrowsNum = rowsNum + 1keyNm = 1'sheet.cells(rowsNum, 1) = keycodesheet.cells(rowsNum, 1) = "PK_"+tab.codesheet.cells(rowsNum, 2) = "UNIQUE"sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Mergesheet.cells(rowsNum, 3) = keystrEnd If
   End Sub Sub ShowTableList(mdl, SheetList)Dim rowsNumrowsNum=1SheetList.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 + 1SheetList.cells(rowsNum, 1) = mdl.nameDim tabFor Each tab In mdl.tablesIf IsObject(tab) ThenrowsNum = rowsNum + 1SheetList.cells(rowsNum, 1) = ""SheetList.cells(rowsNum, 2) = replace(tab.name, tab.code, "")SheetList.cells(rowsNum, 3) = tab.codeSheetList.cells(rowsNum, 4) = tab.commentsheetList.Hyperlinks.Add sheetList.cells(rowsNum,3), "",tab.code&"!B1"sheetList.Hyperlinks.Add sheetList.cells(rowsNum,2), "",tab.code&"!B1"End IfNextSheetList.Range(SheetList.cells(1, 1),SheetList.cells(rowsNum, 4)).Borders.LineStyle = "1"SheetList.Range(SheetList.cells(1, 1),SheetList.cells(rowsNum, 4)).Font.Size=10SheetList.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 = TrueSheetList.Range(SheetList.cells(2, 1),SheetList.cells(rowsNum, 3)).Font.Bold = TrueSheetList.Range(SheetList.cells(1, 5),SheetList.cells(rowsNum, 5)) = " "EXCEL.ActiveWindow.DisplayGridlines = FalseEnd Sub
   

    

3. 点击run
4. 喝杯咖啡等待结果
5. 效果如下

• 目录效果
• 表效果：
• 
• 备注：

1. 暂未支持PD中package，不过也可以手工处理下pdm文件，具体可私聊
2. 颜色搭配来源于一个没办法盘的客户（扶额）
3. 颜色懒的改脚本的人就就就手工改一下吧
4. 为啥没写注释？懒+VBS有现成的用就成了，学了也没用

这篇关于pdm转excel-超级豪华版的文章就介绍到这儿，希望我们推荐的文章对编程师们有所帮助！

---