PowerDesigner 数据模型导出为excel（按表名称顺序导出）

源码参考 PowerDesigner 表格导出为excel【https://www.cnblogs.com/gaocong/p/6553080.html】

这个代码把PowerDesigner定义的数据模型导出成excel文件确实很方便好用，不过原来的代码导出数据表的顺序是数据模型创建的顺序，而复杂系统的数据模型定义可能不是按名称顺序创建的，所以调整了一下，调整后的代码，导出的顺序就是按数据表的名称顺序排列的了。

我习惯数据表中英文名称都使用英文，然后在描述里写中文名称，代码里也做了修改，如果需要继续使用中文名称的，可以对比与原文件的区别，自行修改几处差异即可。

在PowerDesigner里切换到数据模型窗口，然后按快捷键ctrl + shift +x，然后运行脚本，需要本地安装有office。

代码如下：

'******************************************************************************
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
    Dim tableCount, maxTableNum, tableNames
    tableCount = Model.tables.count
    maxTableNum = tableCount - 1
    'MsgBox tableCount

    tableNames = SortTableList(Model, tableCount, maxTableNum)

    ' Get the tables collection
    '创建EXCEL APP
    dim beginrow
    DIM EXCEL, colsSheet, tablesSheet
    set EXCEL = CREATEOBJECT("Excel.Application")
    EXCEL.workbooks.add(-4167)'添加工作表
    EXCEL.workbooks(1).sheets(1).name ="表结构"
    set colsSheet = EXCEL.workbooks(1).sheets("表结构")

    EXCEL.workbooks(1).sheets.add
    EXCEL.workbooks(1).sheets(1).name ="目录"
    set tablesSheet = EXCEL.workbooks(1).sheets("目录")

    ' tables list
    ShowTableList Model, tablesSheet, tableNames, maxTableNum

    ' tables properties list
    ShowProperties Model, colsSheet, tablesSheet, tableNames, maxTableNum

    ' tables properties list sheet col set
    EXCEL.workbooks(1).Sheets(2).Select
    EXCEL.visible = true
    '设置列宽和自动换行
    'colsSheet.Columns(1).ColumnWidth = 20
    colsSheet.Columns(1).ColumnWidth = 2
    colsSheet.Columns(2).ColumnWidth = 30
    colsSheet.Columns(3).ColumnWidth = 20
    colsSheet.Columns(4).ColumnWidth = 40
    colsSheet.Columns(5).ColumnWidth = 10
    colsSheet.Columns(6).ColumnWidth = 10
    'colsSheet.Columns(1).WrapText =true
    colsSheet.Columns(2).WrapText =true
    colsSheet.Columns(4).WrapText =true
    '不显示网格线
    EXCEL.ActiveWindow.DisplayGridlines = False

    '*  MsgBox "hello world."
End If

'-----------------------------------------------------------------------------
' Show properties of tables
'-----------------------------------------------------------------------------
Sub ShowProperties(mdl, colsSheet, tablesSheet, tableNames, maxTableNum)
    ' Show tables of the current model/package
    rowsNum = 0
    beginrow = rowsNum + 1
    Dim rowIndex
    rowIndex = 3
    ' For each table
    output "show table properties begin"
    'Dim tab
    'For Each tab In mdl.tables
    '   ShowTable tab, colsSheet, rowIndex, tablesSheet
    '   rowIndex = rowIndex +1
    'Next
    'if mdl.tables.count > 0 then
    '    colsSheet.Range("A" & beginrow + 1 & ":A" & rowsNum).Rows.Group
    'end if
    Dim i, pos
    For i = 0 To maxTableNum
        pos = tableNames(1, i)
        ShowTable mdl.tables.Item(pos), colsSheet, rowIndex, tablesSheet
        rowIndex = rowIndex +1
    Next

    output "end"
End Sub

'-----------------------------------------------------------------------------
' Show table properties
'-----------------------------------------------------------------------------
Sub ShowTable(tab, colsSheet, rowIndex, tablesSheet)
    If IsObject(tab) Then
        Dim rangFlag
        rowsNum = rowsNum + 1
        ' Show properties
        Output "================================"
        'colsSheet.cells(rowsNum, 1) = tab.name
        colsSheet.cells(rowsNum, 1).HorizontalAlignment = 3
        colsSheet.cells(rowsNum, 2) = tab.code
        'colsSheet.cells(rowsNum, 5).HorizontalAlignment = 3
        'colsSheet.cells(rowsNum, 6) = ""
        'colsSheet.cells(rowsNum, 7) = "表说明"
        colsSheet.cells(rowsNum, 3) = tab.comment
        'colsSheet.cells(rowsNum, 8).HorizontalAlignment=3
        colsSheet.Range(colsSheet.cells(rowsNum, 3), colsSheet.cells(rowsNum, 7)).Merge
        '设置超链接，从目录点击表名去查看表结构
        '字段中文名    字段英文名    字段类型    注释    是否主键    是否非空    默认值
        tablesSheet.Hyperlinks.Add tablesSheet.cells(rowIndex, 2), "","表结构"&"!B"&rowsNum
        rowsNum = rowsNum + 1
        'colsSheet.cells(rowsNum, 1) = "字段中文名"
        colsSheet.cells(rowsNum, 2) = "字段英文名"
        colsSheet.cells(rowsNum, 3) = "字段类型"
        colsSheet.cells(rowsNum, 4) = "注释"
        colsSheet.cells(rowsNum, 5) = "是否主键"
        colsSheet.cells(rowsNum, 6) = "是否非空"
        colsSheet.cells(rowsNum, 7) = "默认值"
        '设置边框
        colsSheet.Range(colsSheet.cells(rowsNum-1, 1), colsSheet.cells(rowsNum, 7)).Borders.LineStyle = "1"
        'colsSheet.Range(colsSheet.cells(rowsNum-1, 4), colsSheet.cells(rowsNum, 9)).Borders.LineStyle = "1"
        '字体为10号
        colsSheet.Range(colsSheet.cells(rowsNum-1, 1), colsSheet.cells(rowsNum, 7)).Font.Size = 10
        Dim col ' running column
        Dim colsNum
        colsNum = 0
        for each col in tab.columns
            rowsNum = rowsNum + 1
            colsNum = colsNum + 1
            'colsSheet.cells(rowsNum, 1) = col.name
            'colsSheet.cells(rowsNum, 3) = ""
            'colsSheet.cells(rowsNum, 4) = col.name
            colsSheet.cells(rowsNum, 2) = col.code
            colsSheet.cells(rowsNum, 3) = col.datatype
            colsSheet.cells(rowsNum, 4) = col.comment
            If col.Primary = true Then
                colsSheet.cells(rowsNum, 5) = "Y"
            Else
                colsSheet.cells(rowsNum, 5) = " "
            End If
            If col.Mandatory = true Then
                colsSheet.cells(rowsNum, 6) = "Y"
            Else
                colsSheet.cells(rowsNum, 6) = " "
            End If
            colsSheet.cells(rowsNum, 7) =  col.defaultvalue
        next
        colsSheet.Range(colsSheet.cells(rowsNum - colsNum + 1, 1), colsSheet.cells(rowsNum, 7)).Borders.LineStyle = "3"
        'colsSheet.Range(colsSheet.cells(rowsNum - colsNum + 1, 4), colsSheet.cells(rowsNum, 9)).Borders.LineStyle = "3"
        colsSheet.Range(colsSheet.cells(rowsNum - colsNum + 1, 1), colsSheet.cells(rowsNum, 7)).Font.Size = 10
        rowsNum = rowsNum + 2

        Output "FullDescription: "       + tab.Name
    End If
End Sub

'-----------------------------------------------------------------------------
' Show List Of Table
'-----------------------------------------------------------------------------
Sub ShowTableList(mdl, tablesSheet, tableNames, maxTableNum)
    ' Show tables of the current model/package
    Dim rowsNo
    rowsNo = 1
    ' For each table
    output "show table list begin"
    tablesSheet.cells(rowsNo, 1) = "主题"
    tablesSheet.cells(rowsNo, 2) = "表中文名"
    tablesSheet.cells(rowsNo, 3) = "表英文名"
    tablesSheet.cells(rowsNo, 4) = "表说明"
    rowsNo = rowsNo + 1
    tablesSheet.cells(rowsNo, 1) = mdl.name
    'Dim tab
    'For Each tab In mdl.tables
    '    If IsObject(tab) Then
    '        rowsNo = rowsNo + 1
    '        tablesSheet.cells(rowsNo, 1) = ""
    '        tablesSheet.cells(rowsNo, 2) = tab.name
    '        tablesSheet.cells(rowsNo, 3) = tab.code
    '        tablesSheet.cells(rowsNo, 4) = tab.comment
    '    End If
    'Next
    Dim i, pos
    For i = 0 To maxTableNum
        pos = tableNames(1, i)
        'output tableNames(0, i) & "-" & pos
        'If IsObject(tab) Then
            rowsNo = rowsNo + 1
            tablesSheet.cells(rowsNo, 1) = ""
            tablesSheet.cells(rowsNo, 2) = mdl.tables.Item(pos).name
            tablesSheet.cells(rowsNo, 3) = mdl.tables.Item(pos).code
            tablesSheet.cells(rowsNo, 4) = mdl.tables.Item(pos).comment
        'End If
    Next
    tablesSheet.Columns(1).ColumnWidth = 20
    tablesSheet.Columns(2).ColumnWidth = 20
    tablesSheet.Columns(3).ColumnWidth = 30
    tablesSheet.Columns(4).ColumnWidth = 60
    output "end"
End Sub

'-----------------------------------------------------------------------------
' Get Table List Sort By Name
'-----------------------------------------------------------------------------
Function SortTableList(mdl, count, maxNum)
    Dim tabs()
    ReDim tabs(2, count)
    Dim tab, i, j, temp

    'output "get table names"
    For i = 0 To maxNum
        temp = mdl.tables.Item(i).name
        tabs(0, i) = temp
        'output temp
    Next

    'output "sort table names"
    For i = 0 To maxNum
        For j = i + 1 To maxNum
            If tabs(0, j) < tabs(0, i) Then
                temp = tabs(0, i)
                tabs(0, i) = tabs(0, j)
                tabs(0, j) = temp
            End If
        Next
    Next

    'output "put table index to sorted names"
    i = 0
    For Each tab In Model.tables
        temp = tab.name
        'output tab.name
        For j = 0 To maxNum
            If (tabs(0, j)) = temp Then
                tabs(1, j) = i
            End If
        Next
        i = i + 1
    Next
    'For i = 0 To maxNum
    '    output tabs(0, i) + "-" & tabs(1, i)
    'Next
    SortTableList = tabs
End Function