在Tools=>Execute Commands下的Edit/Run Scripts,或者通过Ctrl+Shift+X就可以运行脚本。如图:
1.将所有的表名和列名都修改为大写
'***************************************************************************** '文件:powerdesigner.ucase.VBs '版本:1.0 '功能:遍历物理模型中的所有表,将表名、表代码、字段名、字段代码全部由小写改成大写; ' 并将序列的名和代码由小写改成大写。 '用法:打开物理模型,运行本脚本(Ctrl+Shift+X) '备注: '***************************************************************************** dim model 'current model set model = ActiveModel If (model Is Nothing) Then MsgBox "There is no current Model" ElseIf Not model.IsKindOf(PdPDM.cls_Model) Then MsgBox "The current model is not an Physical Data model." Else ProcessTables model ProcessSequences model End If '***************************************************************************** '函数:ProcessSequences '功能:递归遍历所有的序列 '***************************************************************************** sub ProcessSequences(folder) '处理模型中的序列:小写改大写 dim sequence for each sequence in folder.sequences sequence.name = UCase(sequence.name) sequence.code = UCase(sequence.code) next end sub '***************************************************************************** '函数:ProcessTables '功能:递归遍历所有的表 '***************************************************************************** sub ProcessTables(folder) '处理模型中的表 dim table for each table in folder.tables if not table.IsShortCut then ProcessTable table end if next '对子目录进行递归 dim subFolder for each subFolder in folder.Packages ProcessTables subFolder next end sub '***************************************************************************** '函数:ProcessTable '功能:遍历指定table的所有字段,将字段名由小写改成大写, ' 字段代码由小写改成大写 ' 表名由小写改成大写 '***************************************************************************** sub ProcessTable(table) dim col for each col in table.Columns '将字段名由小写改成大写 col.code = UCase(col.code) col.name = UCase(col.name) next table.name = UCase(table.name) table.code = UCase(table.code) end sub
2.将所有表和字段名称赋值到注释
Option Explicit ValidationMode = True InteractiveMode = im_Batch Dim mdl ' the current model ' get the current active model Set mdl = ActiveModel If (mdl Is Nothing) Then MsgBox "There is no current Model " ElseIf Not mdl.IsKindOf(PdPDM.cls_Model) Then MsgBox "The current model is not an Physical Data model. " Else ProcessFolder mdl End If ' This routine copy name into comment for each table, each column and each view ' of the current folder Private sub ProcessFolder(folder) Dim Tab 'running table for each Tab in folder.tables if not tab.isShortcut then tab.comment = tab.name Dim col ' running column for each col in tab.columns col.comment= col.name next end if next Dim view 'running view for each view in folder.Views if not view.isShortcut then view.comment = view.name end if next ' go into the sub-packages Dim f ' running folder For Each f In folder.Packages if not f.IsShortcut then ProcessFolder f end if Next end sub
3.将所有表和字段名称赋值到注释,如果注释不为空,就让注释=名称+空格+注释
Option Explicit ValidationMode = True InteractiveMode = im_Batch Dim mdl ' the current model ' get the current active model Set mdl = ActiveModel If (mdl Is Nothing) Then MsgBox "There is no current Model " ElseIf Not mdl.IsKindOf(PdPDM.cls_Model) Then MsgBox "The current model is not an Physical Data model. " Else ProcessFolder mdl End If ' This routine copy name into comment for each table, each column and each view ' of the current folder Private sub ProcessFolder(folder) Dim Tab 'running table for each Tab in folder.tables if not tab.isShortcut then tab.comment = tab.name Dim col ' running column for each col in tab.columns if (col.comment =null) Then col.comment= col.name else col.comment= col.name + " " + col.comment end if next end if next Dim view 'running view for each view in folder.Views if not view.isShortcut then view.comment = view.name end if next ' go into the sub-packages Dim f ' running folder For Each f In folder.Packages if not f.IsShortcut then ProcessFolder f end if Next end sub
4.将所有表导出到Excel
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, BOOK, SHEET Set EXCEL = CreateObject("Excel.Application") EXCEL.Visible = True Set BOOK = EXCEL.Workbooks.Add(-4167) '新建工作簿 BOOK.Sheets(1).Name = "数据库表结构" Set SHEET = EXCEL.workbooks(1).sheets("数据库表结构") ShowProperties Model, SHEET EXCEL.visible = true '设置列宽和自动换行 SHEET.Columns(1).ColumnWidth = 10 SHEET.Columns(2).ColumnWidth = 30 SHEET.Columns(3).ColumnWidth = 20 SHEET.Columns(1).WrapText =true SHEET.Columns(2).WrapText =true SHEET.Columns(3).WrapText =true End If '----------------------------------------------------------------------------- ' Show properties of tables '----------------------------------------------------------------------------- Sub ShowProperties(mdl, sheet) ' Show tables of the current model/package rowsNum=0 beginrow = rowsNum+1 ' For each table output "begin" Dim tab For Each tab In mdl.tables ShowTable tab,sheet Next if mdl.tables.count > 0 then sheet.Range("A" & beginrow + 1 & ":A" & rowsNum).Rows.Group end if output "end" End Sub '----------------------------------------------------------------------------- ' 数据表查询 '----------------------------------------------------------------------------- Sub ShowTable(tab, sheet) If IsObject(tab) Then Dim rangFlag sheet.cells(1, 1) = "序号" sheet.cells(1, 2) = "表名" sheet.cells(1, 3) = "实体名" '设置边框 sheet.Range(sheet.cells(1, 1),sheet.cells(1, 3)).Borders.LineStyle = "1" '设置背景颜色 sheet.Range(sheet.cells(1, 1),sheet.cells(1, 3)).Interior.ColorIndex = "19" rowsNum = rowsNum + 1 sheet.cells(rowsNum+1, 1) = rowsNum sheet.cells(rowsNum+1, 2) = tab.code sheet.cells(rowsNum+1, 3) = tab.name '设置边框 sheet.Range(sheet.cells(rowsNum+1,1),sheet.cells(rowsNum+1,3)).Borders.LineStyle = "2" '增加Sheet BOOK.Sheets.Add , BOOK.Sheets(BOOK.Sheets.count) BOOK.Sheets(rowsNum+1).Name = tab.code Dim shtn Set shtn = EXCEL.workbooks(1).sheets(tab.code) '设置列宽和换行 shtn.Columns(1).ColumnWidth = 30 shtn.Columns(2).ColumnWidth = 20 shtn.Columns(3).ColumnWidth = 20 shtn.Columns(5).ColumnWidth = 30 shtn.Columns(6).ColumnWidth = 20 shtn.Columns(1).WrapText =true shtn.Columns(2).WrapText =true shtn.Columns(3).WrapText =true shtn.Columns(5).WrapText =true shtn.Columns(6).WrapText =true '设置列标题 shtn.cells(1, 1) = "字段中文名" shtn.cells(1, 2) = "字段名" shtn.cells(1, 3) = "字段类型" shtn.cells(1, 5) = tab.code shtn.cells(1, 6) = tab.Name '设置边框 shtn.Range(shtn.cells(1, 1),shtn.cells(1, 3)).Borders.LineStyle = "1" shtn.Range(shtn.cells(1, 5),shtn.cells(1, 6)).Borders.LineStyle = "1" '设置背景颜色 shtn.Range(shtn.cells(1, 1),shtn.cells(1, 3)).Interior.ColorIndex = "19" shtn.Range(shtn.cells(1, 5),shtn.cells(1, 6)).Interior.ColorIndex = "19" Dim col ' running column Dim colsNum Dim rNum colsNum = 0 rNum = 0 for each col in tab.columns rNum = rNum + 1 colsNum = colsNum + 1 shtn.cells(rNum+1, 1) = col.name shtn.cells(rNum+1, 2) = col.code shtn.cells(rNum+1, 3) = col.datatype next shtn.Range(shtn.cells(rNum-colsNum+2,1),shtn.cells(rNum+1,3)).Borders.LineStyle = "2" rNum = rNum + 1 Output "FullDescription: " + tab.Name End If End Sub
5.将所有表导出到Excel(包含注释)
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, BOOK, SHEET Set EXCEL = CreateObject("Excel.Application") EXCEL.Visible = True Set BOOK = EXCEL.Workbooks.Add(-4167) '新建工作簿 BOOK.Sheets(1).Name = "数据库表结构" Set SHEET = EXCEL.workbooks(1).sheets("数据库表结构") ShowProperties Model, SHEET EXCEL.visible = true '设置列宽和自动换行 SHEET.Columns(1).ColumnWidth = 10 SHEET.Columns(2).ColumnWidth = 30 SHEET.Columns(3).ColumnWidth = 20 SHEET.Columns(1).WrapText =true SHEET.Columns(2).WrapText =true SHEET.Columns(3).WrapText =true End If '----------------------------------------------------------------------------- ' Show properties of tables '----------------------------------------------------------------------------- Sub ShowProperties(mdl, sheet) ' Show tables of the current model/package rowsNum=0 beginrow = rowsNum+1 ' For each table output "begin" Dim tab For Each tab In mdl.tables ShowTable tab,sheet Next if mdl.tables.count > 0 then sheet.Range("A" & beginrow + 1 & ":A" & rowsNum).Rows.Group end if output "end" End Sub '----------------------------------------------------------------------------- ' 数据表查询 '----------------------------------------------------------------------------- Sub ShowTable(tab, sheet) If IsObject(tab) Then Dim rangFlag sheet.cells(1, 1) = "序号" sheet.cells(1, 2) = "表名" sheet.cells(1, 3) = "实体名" '设置边框 sheet.Range(sheet.cells(1, 1),sheet.cells(1, 3)).Borders.LineStyle = "1" '设置背景颜色 sheet.Range(sheet.cells(1, 1),sheet.cells(1, 3)).Interior.ColorIndex = "19" rowsNum = rowsNum + 1 sheet.cells(rowsNum+1, 1) = rowsNum sheet.cells(rowsNum+1, 2) = tab.code sheet.cells(rowsNum+1, 3) = tab.name '设置边框 sheet.Range(sheet.cells(rowsNum+1,1),sheet.cells(rowsNum+1,3)).Borders.LineStyle = "2" '增加Sheet BOOK.Sheets.Add , BOOK.Sheets(BOOK.Sheets.count) BOOK.Sheets(rowsNum+1).Name = tab.code Dim shtn Set shtn = EXCEL.workbooks(1).sheets(tab.code) '设置列宽和换行 shtn.Columns(1).ColumnWidth = 30 shtn.Columns(2).ColumnWidth = 20 shtn.Columns(3).ColumnWidth = 20 shtn.Columns(4).ColumnWidth = 60 shtn.Columns(5).ColumnWidth = 30 shtn.Columns(6).ColumnWidth = 20 shtn.Columns(1).WrapText =true shtn.Columns(2).WrapText =true shtn.Columns(3).WrapText =true shtn.Columns(4).WrapText =true shtn.Columns(5).WrapText =true shtn.Columns(6).WrapText =true '设置列标题 shtn.cells(2, 1) = "字段中文名" shtn.cells(2, 2) = "字段名" shtn.cells(2, 3) = "字段类型" shtn.cells(2, 4) = "注释" shtn.cells(1, 1) = tab.code+"("+tab.Name+")" '设置边框 shtn.Range(shtn.cells(2, 1),shtn.cells(2, 3)).Borders.LineStyle = "1" '设置背景颜色 shtn.Range(shtn.cells(2, 1),shtn.cells(2, 4)).Interior.ColorIndex = "19" '合并单元格 shtn.Range(shtn.cells(1, 1), shtn.cells(1, 4)).Merge '居中对齐 shtn.cells(1, 1).HorizontalAlignment = -4108 Dim col ' running column Dim colsNum Dim rNum colsNum = 0 rNum = 0 for each col in tab.columns rNum = rNum + 1 colsNum = colsNum + 1 shtn.cells(rNum+2, 1) = col.name shtn.cells(rNum+2, 2) = col.code shtn.cells(rNum+2, 3) = col.datatype shtn.cells(rNum+2, 4) = col.comment next shtn.Range(shtn.cells(rNum-colsNum+2,1),shtn.cells(rNum+2,4)).Borders.LineStyle = "2" rNum = rNum + 1 Output "FullDescription: " + tab.Name End If End Sub