源码参考 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
![测试基础第一课[图]](data:image/gif;base64,R0lGODlhAQABAIAAAP///wAAACwAAAAAAQABAAACAkQBADs=)