源碼參考 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=)