pdm转excel-超级豪华版2（支持Package）

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

1. 支持每个表一个sheet页
2. 支持目录索引
3. 支持每个sheet页返回目录
4. 支持索引
5. 支持主键
6. 支持Powder Designer包处理
7. 优化excel界面

• 效果图如下：
• 目录
• 
• 单独sheet页
• 
• 步骤如下：

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

Option Explicit
DIM mdl ' the current model
SET mdl = ActiveModel
IF (mdl IS NOTHING) THEN
   MsgBox "没有选择一个Model"
END IF
DIM fldr
SET fldr = ActiveDiagram.Parent
'创建新的Excel
Dim EXCEL, sheetList
Set EXCEL = CreateObject("Excel.Application") 
EXCEL.Visible = True 
EXCEL.Workbooks.Add
ExpModToExcel(fldr)
'开始循环处理所有的folder
AddExcelSheet("目录")
set sheetList = EXCEL.workbooks(1).sheets("目录")
Dim rowsNum
rowsNum=1
CreateContactHead()
ExpModToExcelContacts(fldr)
MsgBox "成功将 Models 导出到Excel中！"
PRIVATE FUNCTION ExpModToExcel(folder)
'开始循环处理所有的folder
CreateTabs(folder.Tables)
'对子包进行递归，
DIM subfolder
FOR EACH subfolder IN folder.Packages
ExpModToExcel(subfolder) 
NEXT
END FUNCTION
PRIVATE FUNCTION ExpModToExcelContacts(folder)
CreateContactBody(folder)
'对子包进行递归
DIM subfolder
FOR EACH subfolder IN folder.Packages
ExpModToExcelContacts(subfolder) 
NEXT
END FUNCTION
Sub CreateContactHead()
    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 
End Sub
Sub CreateContactBody(folder)
    rowsNum = rowsNum + 1
    sheetList.cells(rowsNum, 1) = folder.name
    Dim tab
    For Each tab In folder.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), "",replace(tab.name, tab.code, "")&"!B1"
            sheetList.Hyperlinks.Add sheetList.cells(rowsNum,2), "",replace(tab.name, 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 = "15"
    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
PRIVATE SUB AddExcelSheet(sheetname)
  EXCEL.Sheets.Add
  EXCEL.ActiveSheet.Name=sheetname
END SUB
Sub CreateTabs(tables)
    Dim rowsNum, tablecode, tablname, sheet
Dim tab
Dim tablename
    rowsNum = 0
    For Each tab In tables
        rowsNum = 1
tablename = replace(tab.name, tab.code, "")
AddExcelSheet(tablename)
        set sheet = EXCEL.workbooks(1).sheets(tablename)
        tablecode = tab.code
        sheet.cells(rowsNum, 1) = "表中文名"
        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
        addTabsPK sheet, tab, rowsNum
        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
        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 = "40"
        sheet.Range(sheet.cells(5, 1),sheet.cells(5, 7)).Interior.colorindex = "15"
        sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).RowHeight = "21"
        sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 1)).ColumnWidth = "30"
        sheet.Range(sheet.cells(1, 2),sheet.cells(rowsNum, 2)).ColumnWidth = "20"
        sheet.Range(sheet.cells(1, 3),sheet.cells(rowsNum, 3)).ColumnWidth = "20"
        sheet.Range(sheet.cells(1, 4),sheet.cells(rowsNum, 4)).ColumnWidth = "10"
        sheet.Range(sheet.cells(1, 5),sheet.cells(rowsNum, 5)).ColumnWidth = "10"
        sheet.Range(sheet.cells(1, 6),sheet.cells(rowsNum, 6)).ColumnWidth = "10"
        sheet.Range(sheet.cells(1, 7),sheet.cells(rowsNum, 7)).ColumnWidth = "70"
        sheet.Range(sheet.cells(1, 8),sheet.cells(rowsNum, 8)) = " "
        sheet.Range(sheet.cells(1, 1),sheet.cells(3, 7)).Font.Bold = True
sheet.Range(sheet.cells(5, 1),sheet.cells(5, 7)).Font.Bold = True
EXCEL.ActiveWindow.DisplayGridlines = False
    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
            IF col.primary THEN
                sheet.cells(rowsNum, 6) = "Y"
            END IF
            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
    sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 7)).Interior.colorindex = "40"
    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 addTabsPK(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) = ucase("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