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 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
   

    

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

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

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