1.将Powerdesigner中的表（PDM）导入到execel中
Ctrl+Shift+X/tool->Execute commands ->Edit/Run script
粘贴如下vbscript脚本(经测试成功运行)：
'******************************************************************************
Option Explicit
Dim rowsNum
rowsNum =
'-----------------------------------------------------------------------------
' 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
'创建EXCEL APP
dim beginrow
DIM EXCEL, SHEET, SHEETLIST
set EXCEL = CREATEOBJECT("Excel.Application")
EXCEL.workbooks.add(-)'添加工作表
EXCEL.workbooks().sheets().name ="表结构"
set SHEET = EXCEL.workbooks().sheets("表结构") EXCEL.workbooks().sheets.add
EXCEL.workbooks().sheets().name ="目录"
set SHEETLIST = EXCEL.workbooks().sheets("目录")
ShowTableList Model,SHEETLIST ShowProperties Model, SHEET,SHEETLIST EXCEL.workbooks().Sheets().Select
EXCEL.visible = true
'设置列宽和自动换行
sheet.Columns().ColumnWidth =
sheet.Columns().ColumnWidth =
sheet.Columns().ColumnWidth =
sheet.Columns().ColumnWidth =
sheet.Columns().ColumnWidth =
sheet.Columns().ColumnWidth =
sheet.Columns().ColumnWidth =
sheet.Columns().ColumnWidth =
sheet.Columns().ColumnWidth =
sheet.Columns().WrapText =true
sheet.Columns().WrapText =true
sheet.Columns().WrapText =true
'不显示网格线
EXCEL.ActiveWindow.DisplayGridlines = False End If
'-----------------------------------------------------------------------------
' Show properties of tables
'-----------------------------------------------------------------------------
Sub ShowProperties(mdl, sheet,SheetList)
' Show tables of the current model/package
rowsNum=
beginrow = rowsNum+
Dim rowIndex
rowIndex=
' For each table
output "begin"
Dim tab
For Each tab In mdl.tables
ShowTable tab,sheet,rowIndex,sheetList
rowIndex = rowIndex +
Next
if mdl.tables.count > then
sheet.Range("A" & beginrow + & ":A" & rowsNum).Rows.Group
end if
output "end"
End Sub
'-----------------------------------------------------------------------------
' Show table properties
'-----------------------------------------------------------------------------
Sub ShowTable(tab, sheet,rowIndex,sheetList)
If IsObject(tab) Then
Dim rangFlag
rowsNum = rowsNum +
' Show properties
Output "================================"
sheet.cells(rowsNum, ) =tab.name
sheet.cells(rowsNum, ).HorizontalAlignment=
sheet.cells(rowsNum, ) = tab.code
'sheet.cells(rowsNum, 5).HorizontalAlignment=3
'sheet.cells(rowsNum, 6) = ""
'sheet.cells(rowsNum, 7) = "表说明"
sheet.cells(rowsNum, ) = tab.comment
'sheet.cells(rowsNum, 8).HorizontalAlignment=3
sheet.Range(sheet.cells(rowsNum, ),sheet.cells(rowsNum, )).Merge
'设置超链接，从目录点击表名去查看表结构
'字段中文名 字段英文名 字段类型 注释 是否主键 是否非空 默认值
sheetList.Hyperlinks.Add sheetList.cells(rowIndex,), "","表结构"&"!B"&rowsNum
rowsNum = rowsNum +
sheet.cells(rowsNum, ) = "字段中文名"
sheet.cells(rowsNum, ) = "字段英文名"
sheet.cells(rowsNum, ) = "字段类型"
sheet.cells(rowsNum, ) = "字段长度"
sheet.cells(rowsNum, ) = "注释"
sheet.cells(rowsNum, ) = "是否主键"
sheet.cells(rowsNum, ) = "是否外键"
sheet.cells(rowsNum, ) = "是否非空"
sheet.cells(rowsNum, ) = "默认值"
'设置边框
sheet.Range(sheet.cells(rowsNum-, ),sheet.cells(rowsNum, )).Borders.LineStyle = ""
'字体为10号
sheet.Range(sheet.cells(rowsNum-, ),sheet.cells(rowsNum, )).Font.Size=
Dim col ' running column
Dim colsNum
colsNum =
for each col in tab.columns
rowsNum = rowsNum +
colsNum = colsNum +
sheet.cells(rowsNum, ) = col.name
sheet.cells(rowsNum, ) = col.code
sheet.cells(rowsNum, ) = col.datatype
sheet.cells(rowsNum, ) = col.length
'sheet.cells(rowsNum, 4) = col.name
sheet.cells(rowsNum, ) = col.comment
If col.Primary = true Then
sheet.cells(rowsNum, ) = "Y"
Else
sheet.cells(rowsNum, ) = " "
End If
If col.ForeignKey= true Then
sheet.cells(rowsNum, ) = "Y"
Else
sheet.cells(rowsNum, ) = " "
End If
If col.Mandatory = true Then
sheet.cells(rowsNum, ) = "Y"
Else
sheet.cells(rowsNum, ) = " "
End If
sheet.cells(rowsNum, ) = col.defaultvalue
next
sheet.Range(sheet.cells(rowsNum-colsNum+,),sheet.cells(rowsNum,)).Borders.LineStyle = ""
sheet.Range(sheet.cells(rowsNum-colsNum+,),sheet.cells(rowsNum,)).Font.Size =
rowsNum = rowsNum + Output "FullDescription: " + tab.Name
End If End Sub
'-----------------------------------------------------------------------------
' Show List Of Table
'-----------------------------------------------------------------------------
Sub ShowTableList(mdl, SheetList)
' Show tables of the current model/package
Dim rowsNo
rowsNo=
' For each table
output "begin"
SheetList.cells(rowsNo, ) = "主题"
SheetList.cells(rowsNo, ) = "表中文名"
SheetList.cells(rowsNo, ) = "表英文名"
SheetList.cells(rowsNo, ) = "表说明"
rowsNo = rowsNo +
SheetList.cells(rowsNo, ) = mdl.name
Dim tab
For Each tab In mdl.tables
If IsObject(tab) Then
rowsNo = rowsNo +
SheetList.cells(rowsNo, ) = ""
SheetList.cells(rowsNo, ) = tab.name
SheetList.cells(rowsNo, ) = tab.code
SheetList.cells(rowsNo, ) = tab.comment
End If
Next
SheetList.Columns().ColumnWidth =
SheetList.Columns().ColumnWidth =
SheetList.Columns().ColumnWidth =
SheetList.Columns().ColumnWidth =
output "end"
End Sub
2.Excel导入Powerdesigner生成模型的vbscript脚本：
'******************************************************************************
'开始
Option Explicit
Dim tab_name,tab_code,tab_comment
Dim b_r, e_r, s_r, j, m, n
Dim mdl ' the current model
dim count
Dim HaveExcel
Dim RQ
Dim file_name,WScript
Set mdl = ActiveModel
If (mdl Is Nothing) Then
MsgBox "There is no Active Model"
End If
RQ = vbYes 'MsgBox("Is Excel Installed on your machine ?", vbYesNo + vbInformation, "Confirmation")
If RQ = vbYes Then
HaveExcel = True
' Open & Create Excel Document
Else
HaveExcel = False
End If
file_name = selectFile()
if file_name <> "" then
Dim x1 '
Set x1 = CreateObject("Excel.Application")
x1.Workbooks.Open file_name '指定excel文档路径
x1.Workbooks().Worksheets("表结构").Activate '指定要打开的sheet名称
j =
do while n <
if x1.Workbooks().Worksheets("表结构").cells(j,).value <> "" then
call a(x1, mdl, j, getRow(x1, j))
'msgbox j & "--" & getRow(x1, j)
count = count +
j = getRow(x1, j)
n =
end if
j = j +
n = n +
loop
'MsgBox "生成数据表结构共计 " + CStr(count), vbOK + vbInformation, "表 导入完毕!"
MsgBox "生成数据表结构共计 " & CStr(count) & " 表导入完毕!"
x1.Workbooks().close
x1.quit
else
msgbox "没有选择文件!"
end if sub a(x1, mdl, r_0,r_9)
dim rwIndex
dim tableName
dim colname
dim table
dim col tab_name = ucase(x1.Workbooks().Worksheets("表结构").cells(r_0,).value) '指定表名，如果在Excel文档里有，也可以 .Cells(rwIndex, 3).Value 这样指定
tab_code = ucase(x1.Workbooks().Worksheets("表结构").cells(r_0,).value) '指定表名
tab_comment = ucase(x1.Workbooks().Worksheets("表结构").cells(r_0,).value) on error Resume Next
set table = mdl.Tables.CreateNew '创建一个表实体
table.Name = tab_name
table.Code = tab_code
table.Comment = tab_comment For rwIndex = r_0 + To r_9 '指定要遍历的Excel行标 由于第1行是表头，从第2行开始
With x1.Workbooks().Worksheets("表结构")
If .Cells(rwIndex, ).Value = "" Then
Exit For
End If
set col = table.Columns.CreateNew '创建一列/字段
'MsgBox .Cells(rwIndex, 1).Value, vbOK + vbInformation, "列"
If .Cells(rwIndex, ).Value = "" Then
col.Name = ucase(.Cells(rwIndex, ).Value) '指定列名
Else
col.Name = ucase(.Cells(rwIndex, ).Value)
End If
'MsgBox col.Name, vbOK + vbInformation, "列"
col.Code = ucase(.Cells(rwIndex, ).Value) '指定列名 col.DataType = ucase(.Cells(rwIndex, ).Value) '指定列数据类型 col.Comment = ucase(.Cells(rwIndex, ).Value) '指定列说明 If ucase(.Cells(rwIndex, ).Value) = "Y" Then
col.Primary = true '指定主键
col.defaultvalue = ucase(.Cells(rwIndex,).value)
End If
If ucase(.Cells(rwIndex,).value) = "Y" then
col.defaultvalue = ucase(.Cells(rwIndex,).value)
col.Mandatory = true
End If End With
Next
End sub Function getRow(x1, s_r)
dim i, k
k = s_r
do while x1.Workbooks().Worksheets("表结构").cells(k,).value <> ""
k = k +
if x1.Workbooks().Worksheets("表结构").cells(k,).value = "" then
getRow = k -
exit function
end if
loop
End Function
Function SelectFile()
Dim shell : Set shell = CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim tempFolder : Set tempFolder = fso.GetSpecialFolder()
Dim tempName : tempName = fso.GetTempName()
Dim tempFile : Set tempFile = tempFolder.CreateTextFile(tempName & ".hta")
tempFile.Write _
"<html>" & _
"<head>" & _
"<title>Browse</title>" & _
"</head>" & _
"<body>" & _
"<input type='file' id='f' />" & _
"<script type='text/javascript'>" & _
"var f = document.getElementById('f');" & _
"f.click();" & _
"var shell = new ActiveXObject('WScript.Shell');" & _
"shell.RegWrite('HKEY_CURRENT_USER\\Volatile Environment\\MsgResp', f.value);" & _
"window.close();" & _
"</script>" & _
"</body>" & _
"</html>"
tempFile.Close
shell.Run tempFolder & "\" & tempName & ".hta", , True
SelectFile = shell.RegRead("HKEY_CURRENT_USER\Volatile Environment\MsgResp")
shell.RegDelete "HKEY_CURRENT_USER\Volatile Environment\MsgResp"
End Function
3.使用方式：
以上两个脚本分别以后缀名称为“.vbs”的方式保存;
4.参考网址：http://www.w 2bc.com/article/225953