PDM文件转换生成excel文件
执行步骤：
1、菜单找到Tools
2、下拉中找到Execute Commands
3、选中Edit/Run Script
4、弹窗里黏贴上上面的代码
5、执行
场景一：
'******************************************************************************
'* Powerdesigner 导出Excel格式数据字典 导出Excel格式文件
'* Created:
'* Version: 1.0
'******************************************************************************
Option Explicit
Dim rowsNum
rowsNum = 2
Dim Model
Set Model = ActiveModel
If (Model Is Nothing) Or (Not Model.IsKindOf(PdPDM.cls_Model)) Then
Debug.print "null"
Else
' Get the tables collection
'创建EXCEL APP
dim beginrow
DIM EXCEL, SHEET
set EXCEL = CREATEOBJECT("Excel.Application")
EXCEL.workbooks.add '添加工作表
SET sheet = EXCEL.workbooks(1).sheets(1)
sheet.name ="数据字典"
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) = "不可空"
sheet.cells(rowsNum, 8) = "默认值"
sheet.cells(rowsNum, 9) = "说明"
sheet.cells(rowsNum, 10) = "表名称"
sheet.cells(rowsNum, 11) = "表中文名称"
sheet.cells(rowsNum, 12) = "表说明"
sheet.Range(sheet.cells(rowsNum,1),sheet.cells(rowsNum,12)).Interior.Color=rgb(166,166,166)
beginrow = rowsNum+1
Dim tab
For Each tab In Model.tables
TableLoop tab,SHEET
Next
EXCEL.visible = true
'设置列宽和自动换行
sheet.Columns(1).ColumnWidth =10
sheet.Columns(2).ColumnWidth =15
sheet.Columns(4).ColumnWidth =20
sheet.Columns(5).ColumnWidth =15
sheet.Columns(6).ColumnWidth =15
sheet.Columns("C:C").EntireColumn.AutoFit
sheet.Columns("i:i").EntireColumn.AutoFit
End If
Sub TableLoop(tab, sheet)
If IsObject(tab) Then
Dim rangFlag
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) = IIF(col.Length<>0,col.Length,"")
sheet.cells(rowsNum, 5) = IIF(col.Primary,"√","")
sheet.cells(rowsNum, 6) = IIF(col.Primary,"√","")
sheet.cells(rowsNum, 7) = IIF(col.Mandatory,"√","")
sheet.cells(rowsNum, 8) = "无"
sheet.cells(rowsNum, 10) = tab.code
sheet.cells(rowsNum, 11) = tab.name
sheet.cells(rowsNum, 12) = tab.comment
next
'设置边框
DIM RanagBorder
SET RanagBorder =sheet.Range(sheet.cells(rowsNum-colsNum,1),sheet.cells(rowsNum,12))
RanagBorder.Borders.LineStyle = "1"
'RaneBorderFun RanagBorder
End If
End Sub
function IIF(flg,tstr,fstr)
if flg then
IIF= tstr
else
IIF= fstr
end if
End function场景二：
'******************************************************************************
'* Powerdesigner 导出Excel格式数据字典 导出Excel格式文件[分包存放]
'* Created: 根网科技
'* Version: 1.0
'******************************************************************************
Option Explicit
Dim rowsNum
rowsNum = 2
Dim Model
Dim pkg
Set Model = ActiveModel
If (Model Is Nothing) Or (Not Model.IsKindOf(PdPDM.cls_Model)) Then
Debug.print "null"
else
' Get the tables collection
'创建EXCEL APP
dim beginrow ,p
DIM EXCEL, SHEET
set EXCEL = CREATEOBJECT("Excel.Application")
EXCEL.workbooks.add '添加工作表
For Each pkg In Model.packages
'MsgBox pkg.name
'MsgBox EXCEL.workbooks(1).Sheets.Count
SET sheet = EXCEL.workbooks(1).sheets(1)
sheet.name =pkg.name
'MsgBox sheet.name
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) = "不可空"
sheet.cells(rowsNum, 8) = "默认值"
sheet.cells(rowsNum, 9) = "说明"
sheet.cells(rowsNum, 10) = "表名称"
sheet.cells(rowsNum, 11) = "表中文名称"
sheet.cells(rowsNum, 12) = "表说明"
sheet.Range(sheet.cells(rowsNum,1),sheet.cells(rowsNum,12)).Interior.Color=rgb(166,166,166)
beginrow = rowsNum+1
Dim tab
For Each tab In pkg.tables
TableLoop tab,SHEET
p=1
'MsgBox sheet.name
Next
EXCEL.workbooks(1).sheets.add '添加工作表
next
EXCEL.visible = true
'设置列宽和自动换行
sheet.Columns(1).ColumnWidth =10
sheet.Columns(2).ColumnWidth =15
sheet.Columns(4).ColumnWidth =20
sheet.Columns(5).ColumnWidth =15
sheet.Columns(6).ColumnWidth =15
sheet.Columns("C:C").EntireColumn.AutoFit
sheet.Columns("i:i").EntireColumn.AutoFit
end if
Sub TableLoop(tab, sheet)
If IsObject(tab) Then
Dim rangFlag
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) = IIF(col.Length<>0,col.Length,"")
sheet.cells(rowsNum, 5) = IIF(col.Primary,"√","")
sheet.cells(rowsNum, 6) = IIF(col.Primary,"√","")
sheet.cells(rowsNum, 7) = IIF(col.Mandatory,"√","")
sheet.cells(rowsNum, 8) = "无"
sheet.cells(rowsNum, 10) = tab.code
sheet.cells(rowsNum, 11) = tab.name
sheet.cells(rowsNum, 12) = tab.comment
next
'设置边框
DIM RanagBorder
SET RanagBorder =sheet.Range(sheet.cells(rowsNum-colsNum,1),sheet.cells(rowsNum,12))
RanagBorder.Borders.LineStyle = "1"
'RaneBorderFun RanagBorder
End If
End Sub
function IIF(flg,tstr,fstr)
if flg then
IIF= tstr
else
IIF= fstr
end if
End function