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
‘Get the tables collection
‘Create EXCEL APP
dim beginrow
DIM EXCEL, SHEET, SHEETLIST
set EXCEL = CREATEOBJECT("Excel.Application")
EXCEL.workbooks.add(-4167) ‘add sheet1
EXCEL.workbooks(1).sheets(1).name="sheet structure" ‘Sheet1 name
set SHEET = EXCEL.workbooks(1).sheets("sheet structure") ‘Sheet1 object
EXCEL.workbooks(1).sheets.add ‘add worksheet Sheet2
EXCEL.workbooks(1).sheets(1).name = "Table of Contents" ‘Sheet2 name
set SHEETLIST = EXCEL.workbooks(1).sheets("Table of Contents") ‘Sheet2 object
ShowTableList Model,SHEETLIST
ShowProperties Model, SHEET, SHEETLIST
output "Select: "+ EXCEL.workbooks(1).Sheets(2).name
EXCEL.workbooks(1).Sheets(2).Select ‘Select the worksheet that is opened by default
EXCEL.visible = true ‘pop up Excel workbook
‘Set column width
sheet.Columns(1).ColumnWidth = 20
sheet.Columns(2).ColumnWidth = 20
sheet.Columns(3).ColumnWidth = 20
sheet.Columns(4).ColumnWidth = 40
‘Add the number of columns as needed, here are 4 columns, followed by word wrap
sheet.Columns(1).WrapText =true
sheet.Columns(2).WrapText =true
sheet.Columns(4).WrapText =true
‘Do not show grid lines
EXCEL.ActiveWindow.DisplayGridlines = True
End If
'------------------------------------------------- ----------------------------
‘Show properties of tables
'------------------------------------------------- ----------------------------
Sub ShowProperties(mdl, sheet,SheetList)
‘Show tables of the current model/package
rowsNum=0
beginrow = rowsNum+1
Dim rowIndex ‘set the link position for the table of contents
rowIndex=3
‘For each table
output "table structure begin ========================"
Dim tab ‘Power Tables
For Each tab In mdl.tables
ShowTable tab,sheet,rowIndex,sheetList
rowIndex = rowIndex +1
Next
if mdl.tables.count> 0 then
sheet.Range("A" & beginrow + 1 & ":A" & rowsNum).Rows.Group
end if
output "table structure end!"
End Sub
'------------------------------------------------- ----------------------------
‘Show table properties
'------------------------------------------------- ----------------------------
Sub ShowTable(tab, sheet,rowIndex,sheetList)
If IsObject(tab) Then
rowsNum = rowsNum + 1 ‘rowsNum=1, the first row of the worksheet
‘Show properties
Output ": Table" + tab.name + "Structure"
sheet.cells(rowsNum, 1) =tab.name
sheet.cells(rowsNum, 1).HorizontalAlignment=3
sheet.cells(rowsNum, 2) = tab.code
‘Sheet.cells(rowsNum, 3) = tab.comment
‘Sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 4)).Merge ‘merge cells
‘Set a hyperlink, click on the table name from the table of contents to view the table structure
sheetList.Hyperlinks.Add sheetList.cells(rowIndex,2), "","table structure"&"!B"&rowsNum
‘Field name Field code Data type Comment
rowsNum = rowsNum + 1 ‘rowsNum=2, row 2 of the worksheet
sheet.cells(rowsNum, 1) = "Field name"
sheet.cells(rowsNum, 2) = "Field Code"
sheet.cells(rowsNum, 3) = "Data Type"
sheet.cells(rowsNum, 4) = "Comment"
‘Set border
sheet.Range(sheet.cells(rowsNum-1, 1),sheet.cells(rowsNum, 4)).Borders.LineStyle = "1"
‘The font is number 10
sheet.Range(sheet.cells(rowsNum-1, 1),sheet.cells(rowsNum, 4)).Font.Size=10
Dim col ‘running column
Dim colsNum
colsNum = 0
for each col in tab.columns
rowsNum = rowsNum + 1
colsNum = colsNum + 1
sheet.cells(rowsNum, 1) = col.name
sheet.cells(rowsNum, 2) = col.code
sheet.cells(rowsNum, 3) = col.datatype
sheet.cells(rowsNum, 4) = col.comment
‘5 is the primary key, 6 is the constraint is Null, 7 is the default value
‘If col.Primary = true Then
‘Sheet.cells(rowsNum, 5) = "Y"
‘Else
‘Sheet.cells(rowsNum, 5) = ""
‘End If
‘If col.Mandatory = true Then
‘Sheet.cells(rowsNum, 6) = "Y"
‘Else
‘Sheet.cells(rowsNum, 6) = ""
‘End If
‘Sheet.cells(rowsNum, 7) = col.defaultvalue
next
sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,4)).Borders.LineStyle = "3" ‘Style3 has a dashed border line
sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,4)).Font.Size = 10
rowsNum = rowsNum + 2 ‘The table interval is 2 rows
End If
End Sub
'------------------------------------------------- ----------------------------
‘Show List Of Table
'------------------------------------------------- ----------------------------
Sub ShowTableList(mdl, SheetList)
‘Show tables of the current model/package
Dim rowsNo
rowsNo=1
output "directory begin"
SheetList.cells(rowsNo, 1) = "Subject"
SheetList.cells(rowsNo, 2) = "table name"
SheetList.cells(rowsNo, 3) = "Sheet Code"
SheetList.cells(rowsNo, 4) = "Table Description"
rowsNo = rowsNo + 1
SheetList.cells(rowsNo, 1) = mdl.name
‘For each table
Dim tab
For Each tab In mdl.tables
If IsObject(tab) Then
rowsNo = rowsNo + 1
SheetList.cells(rowsNo, 1) = ""
SheetList.cells(rowsNo, 2) = tab.name
SheetList.cells(rowsNo, 3) = tab.code
SheetList.cells(rowsNo, 4) = tab.comment
End If
Next
SheetList.Columns(1).ColumnWidth = 20
SheetList.Columns(2).ColumnWidth = 20
SheetList.Columns(3).ColumnWidth = 30
SheetList.Columns(4).ColumnWidth = 60
output "directory end"
End Sub
Next: PowerDesigner exports the structure of the data table to Excel. One table and one Sheet with link directory
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
‘Get the tables collection
‘Create EXCEL APP
dim beginrow
DIM EXCEL, SHEET, SHEETLIST
set EXCEL = CREATEOBJECT("Excel.Application")
EXCEL.workbooks.add(-4167) ‘add sheet1
EXCEL.workbooks(1).sheets(1).name="sheet structure" ‘Sheet1 name
set SHEET = EXCEL.workbooks(1).sheets("sheet structure") ‘Sheet1 object
EXCEL.workbooks(1).sheets.add ‘add worksheet Sheet2
EXCEL.workbooks(1).sheets(1).name = "Table of Contents" ‘Sheet2 name
set SHEETLIST = EXCEL.workbooks(1).sheets("Table of Contents") ‘Sheet2 object
ShowTableList Model,SHEETLIST
ShowProperties Model, SHEET,SHEETLIST
output "Select: "+ EXCEL.workbooks(1).Sheets(2).name
EXCEL.workbooks(1).Sheets(2).Select ‘Select the worksheet that is opened by default
EXCEL.visible = true ‘pop up Excel workbook
‘Set column width
sheet.Columns(1).ColumnWidth = 20
sheet.Columns(2).ColumnWidth = 20
sheet.Columns(3).ColumnWidth = 20
sheet.Columns(4).ColumnWidth = 40
‘Add the number of columns as needed, here are 4 columns, followed by word wrap
sheet.Columns(1).WrapText =true
sheet.Columns(2).WrapText =true
sheet.Columns(4).WrapText =true
‘Do not show grid lines
EXCEL.ActiveWindow.DisplayGridlines = True
End If
'------------------------------------------------- ----------------------------
‘Show properties of tables
'------------------------------------------------- ----------------------------
Sub ShowProperties(mdl, sheet,SheetList)
‘Show tables of the current model/package
rowsNum=0
beginrow = rowsNum+1
Dim rowIndex ‘set the link position for the table of contents
rowIndex=3
‘For each table
output "table structure begin ========================"
Dim tab ‘Power Tables
For Each tab In mdl.tables
ShowTable tab,sheet,rowIndex,sheetList
rowIndex = rowIndex +1
Next
if mdl.tables.count> 0 then
sheet.Range("A" & beginrow + 1 & ":A" & rowsNum).Rows.Group
end if
output "table structure end!"
End Sub
'------------------------------------------------- ----------------------------
‘Show table properties
'------------------------------------------------- ----------------------------
Sub ShowTable(tab, sheet,rowIndex,sheetList)
If IsObject(tab) Then
rowsNum = rowsNum + 1 ‘rowsNum=1, the first row of the worksheet
‘Show properties
Output ": Table" + tab.name + "Structure"
sheet.cells(rowsNum, 1) =tab.name
sheet.cells(rowsNum, 1).HorizontalAlignment=3
sheet.cells(rowsNum, 2) = tab.code
‘Sheet.cells(rowsNum, 3) = tab.comment
‘Sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 4)).Merge ‘merge cells
‘Set a hyperlink, click on the table name from the table of contents to view the table structure
sheetList.Hyperlinks.Add sheetList.cells(rowIndex,2), "","table structure"&"!B"&rowsNum
‘Field name Field code Data type Comment
rowsNum = rowsNum + 1 ‘rowsNum=2, row 2 of the worksheet
sheet.cells(rowsNum, 1) = "Field name"
sheet.cells(rowsNum, 2) = "Field Code"
sheet.cells(rowsNum, 3) = "Data Type"
sheet.cells(rowsNum, 4) = "Comment"
‘Set border
sheet.Range(sheet.cells(rowsNum-1, 1),sheet.cells(rowsNum, 4)).Borders.LineStyle = "1"
‘The font is number 10
sheet.Range(sheet.cells(rowsNum-1, 1),sheet.cells(rowsNum, 4)).Font.Size=10
Dim col ‘running column
Dim colsNum
colsNum = 0
for each col in tab.columns
rowsNum = rowsNum + 1
colsNum = colsNum + 1
sheet.cells(rowsNum, 1) = col.name
sheet.cells(rowsNum, 2) = col.code
sheet.cells(rowsNum, 3) = col.datatype
sheet.cells(rowsNum, 4) = col.comment
‘5 is the primary key, 6 is the constraint is Null, 7 is the default value
‘If col.Primary = true Then
‘Sheet.cells(rowsNum, 5) = "Y"
‘Else
‘Sheet.cells(rowsNum, 5) = ""
‘End If
‘If col.Mandatory = true Then
‘Sheet.cells(rowsNum, 6) = "Y"
‘Else
‘Sheet.cells(rowsNum, 6) = ""
‘End If
‘Sheet.cells(rowsNum, 7) = col.defaultvalue
next
sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,4)).Borders.LineStyle = "3" ‘Style3 has a dashed border line
sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,4)).Font.Size = 10
rowsNum = rowsNum + 2 ‘The table interval is 2 rows
End If
End Sub
'------------------------------------------------- ----------------------------
‘Show List Of Table
'------------------------------------------------- ----------------------------
Sub ShowTableList(mdl, SheetList)
‘Show tables of the current model/package
Dim rowsNo
rowsNo=1
output "directory begin"
SheetList.cells(rowsNo, 1) = "Subject"
SheetList.cells(rowsNo, 2) = "table name"
SheetList.cells(rowsNo, 3) = "Sheet Code"
SheetList.cells(rowsNo, 4) = "Table Description"
rowsNo = rowsNo + 1
SheetList.cells(rowsNo, 1) = mdl.name
‘For each table
Dim tab
For Each tab In mdl.tables
If IsObject(tab) Then
rowsNo = rowsNo + 1
SheetList.cells(rowsNo, 1) = ""
SheetList.cells(rowsNo, 2) = tab.name
SheetList.cells(rowsNo, 3) = tab.code
SheetList.cells(rowsNo, 4) = tab.comment
End If
Next
SheetList.Columns(1).ColumnWidth = 20
SheetList.Columns(2).ColumnWidth = 20
SheetList.Columns(3).ColumnWidth = 30
SheetList.Columns(4).ColumnWidth = 60
output "directory end"
End Sub
