在数据库建模中会用到Powerdesigner软件进行表结构的设计,有时候我们需要将Excel里面的表结构导入到Powerdesigner中生成模型文件,或者将Powerdesigner中已有的模型导出生成Excel文档;我们可以通过Powerdesigner的脚本定制功能,来实现Excel的导入导出。
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(1).Worksheets("表结构").Activate '指定要打开的sheet名称
j = 1
do while n < 11
if x1.Workbooks(1).Worksheets("表结构").cells(j,1).value <> "" then
call a(x1, mdl, j, getRow(x1, j))
'msgbox j & "--" & getRow(x1, j)
count = count + 1
j = getRow(x1, j)
n = 0
end if
j = j + 1
n = n + 1
loop
'MsgBox "生成数据表结构共计 " + CStr(count), vbOK + vbInformation, "表 导入完毕!"
MsgBox "生成数据表结构共计 " & CStr(count) & " 表导入完毕!"
x1.Workbooks(1).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(1).Worksheets("表结构").cells(r_0,1).value) '指定表名,如果在Excel文档里有,也可以 .Cells(rwIndex, 3).Value 这样指定
tab_code = ucase(x1.Workbooks(1).Worksheets("表结构").cells(r_0,2).value) '指定表名
tab_comment = ucase(x1.Workbooks(1).Worksheets("表结构").cells(r_0,3).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 + 2 To r_9 '指定要遍历的Excel行标 由于第1行是表头,从第2行开始
With x1.Workbooks(1).Worksheets("表结构")
If .Cells(rwIndex, 2).Value = "" Then
Exit For
End If
set col = table.Columns.CreateNew '创建一列/字段
'MsgBox .Cells(rwIndex, 1).Value, vbOK + vbInformation, "列"
If .Cells(rwIndex, 1).Value = "" Then
col.Name = ucase(.Cells(rwIndex, 2).Value) '指定列名
Else
col.Name = ucase(.Cells(rwIndex, 1).Value)
End If
'MsgBox col.Name, vbOK + vbInformation, "列"
col.Code = ucase(.Cells(rwIndex, 2).Value) '指定列名
col.DataType = ucase(.Cells(rwIndex, 3).Value) '指定列数据类型
col.Comment = ucase(.Cells(rwIndex, 4).Value) '指定列说明
If ucase(.Cells(rwIndex, 5).Value) = "Y" Then
col.Primary = true '指定主键
col.defaultvalue = ucase(.Cells(rwIndex,7).value)
End If
If ucase(.Cells(rwIndex,6).value) = "Y" then
col.defaultvalue = ucase(.Cells(rwIndex,7).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(1).Worksheets("表结构").cells(k,1).value <> ""
k = k + 1
if x1.Workbooks(1).Worksheets("表结构").cells(k,1).value = "" then
getRow = k - 1
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(2)
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", 0, True
SelectFile = shell.RegRead("HKEY_CURRENT_USER\Volatile Environment\MsgResp")
shell.RegDelete "HKEY_CURRENT_USER\Volatile Environment\MsgResp"
End Function
Powerdesigner模型生成Excel文档的vbscript脚本:
'******************************************************************************
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
'创建EXCEL APP
dim beginrow
DIM EXCEL, SHEET, SHEETLIST
set EXCEL = CREATEOBJECT("Excel.Application")
EXCEL.workbooks.add(-4167)'添加工作表
EXCEL.workbooks(1).sheets(1).name ="表结构"
set SHEET = EXCEL.workbooks(1).sheets("表结构")
EXCEL.workbooks(1).sheets.add
EXCEL.workbooks(1).sheets(1).name ="目录"
set SHEETLIST = EXCEL.workbooks(1).sheets("目录")
ShowTableList Model,SHEETLIST
ShowProperties Model, SHEET,SHEETLIST
EXCEL.workbooks(1).Sheets(2).Select
EXCEL.visible = true
'设置列宽和自动换行
sheet.Columns(1).ColumnWidth = 20
sheet.Columns(2).ColumnWidth = 20
sheet.Columns(3).ColumnWidth = 20
sheet.Columns(4).ColumnWidth = 40
sheet.Columns(5).ColumnWidth = 10
sheet.Columns(6).ColumnWidth = 10
sheet.Columns(1).WrapText =true
sheet.Columns(2).WrapText =true
sheet.Columns(4).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=0
beginrow = rowsNum+1
Dim rowIndex
rowIndex=3
' For each table
output "begin"
Dim tab
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 "end"
End Sub
'-----------------------------------------------------------------------------
' Show table properties
'-----------------------------------------------------------------------------
Sub ShowTable(tab, sheet,rowIndex,sheetList)
If IsObject(tab) Then
Dim rangFlag
rowsNum = rowsNum + 1
' Show properties
Output "================================"
sheet.cells(rowsNum, 1) =tab.name
sheet.cells(rowsNum, 1).HorizontalAlignment=3
sheet.cells(rowsNum, 2) = tab.code
'sheet.cells(rowsNum, 5).HorizontalAlignment=3
'sheet.cells(rowsNum, 6) = ""
'sheet.cells(rowsNum, 7) = "表说明"
sheet.cells(rowsNum, 3) = tab.comment
'sheet.cells(rowsNum, 8).HorizontalAlignment=3
sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Merge
'设置超链接,从目录点击表名去查看表结构
'字段中文名 字段英文名 字段类型 注释 是否主键 是否非空 默认值
sheetList.Hyperlinks.Add sheetList.cells(rowIndex,2), "","表结构"&"!B"&rowsNum
rowsNum = 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.Range(sheet.cells(rowsNum-1, 1),sheet.cells(rowsNum, 7)).Borders.LineStyle = "1"
'sheet.Range(sheet.cells(rowsNum-1, 4),sheet.cells(rowsNum, 9)).Borders.LineStyle = "1"
'字体为10号
sheet.Range(sheet.cells(rowsNum-1, 1),sheet.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
sheet.cells(rowsNum, 1) = col.name
'sheet.cells(rowsNum, 3) = ""
'sheet.cells(rowsNum, 4) = col.name
sheet.cells(rowsNum, 2) = col.code
sheet.cells(rowsNum, 3) = col.datatype
sheet.cells(rowsNum, 4) = col.comment
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,7)).Borders.LineStyle = "3"
'sheet.Range(sheet.cells(rowsNum-colsNum+1,4),sheet.cells(rowsNum,9)).Borders.LineStyle = "3"
sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,7)).Font.Size = 10
rowsNum = rowsNum + 2
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=1
' For each table
output "begin"
SheetList.cells(rowsNo, 1) = "主题"
SheetList.cells(rowsNo, 2) = "表中文名"
SheetList.cells(rowsNo, 3) = "表英文名"
SheetList.cells(rowsNo, 4) = "表说明"
rowsNo = rowsNo + 1
SheetList.cells(rowsNo, 1) = mdl.name
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 "end"
End Sub
使用方式:
以上两个脚本分别以后缀名称为“.vbs”的方式保存;