很多做数据模型开发的小伙伴应该都对PowerDesigner不陌生，这款软件可算是模型开发界长盛不衰的开发工具了。软件功能非常强大的，支持了当先各种主流或非主流数据库的可视化模型开发，而且还能实现逆向工程数据库的表，尤其为做数据仓库小伙伴们实现在线运维提供了强大的平台。
好了前面一段话说完了，下面就说下干货，给大家分享一下如何巧用VB的脚本来辅助我们实现快速的模型设计和调整。
模型设计一般几个基础操作包括模型创建、字段的设计和调整，我举例说下传统的方式是如何的如下图
步骤一、创建数据表
步骤二、创建字段，所有字段均是手动填写
步骤三、调整字段,红格部分是修改的内容。
通过以上三个步骤，可利用可视化的方式创建表和字段信息，但是我们创建模型不仅仅是一个而是几十个或者上百个，而且调整字段也需要基于上百个模型进行调整，所以我们需要借助脚本的方式来实现，会大大增加我们的工作效率。
首先打开脚本页面，如图1，2
第一步，我们如果需要创建大批量的数据表，需要EXCEL来帮助我们一起来实现。
我们可以通过EXCEL先编辑好我们想创建好的表，然后编辑VB脚本创建我们想要的数据表，脚本1
脚本执行后，快速生成了三张数据表，（参考脚本请在文章后面寻找）
以下两个图中，需要对两个表进行调整。如果一两张表手动调整就好，但是如果表非常多一个个调整需要时间成本非常大。所以建议利用脚本实现批量修改
以上两个图中，需要对两个表进行调整。如果一两张表手动调整就好，但是如果表非常多一个个调整需要时间成本非常大。所以建议利用脚本实现批量修改
输入脚本2，让所有表的name列等于所有的COMMENT列（参考脚本请在文章后面寻找）
点击"run"运行，则将所表的name列等于所有的COMMENT列。（参考脚本请在文章后面寻找）
输入脚本3，为所有表增加同样的采集时间字段。（参考脚本请在文章后面寻找）
以上就是PowerDesigner利用脚本开发模型几个基本案例，脚本功能还是非常强大的，利用脚本我们可以把一些设计上重复工作让程序来做，大大提升了我们模型设计工作效率，把更多时间放在模型设计上。
注释：脚本原型均来自网上，作者在原型的基础上进行调整。
运行脚本1代码：
Option Explicit
Dim mdl ' the current model
Set mdl = ActiveModel
If (mdl Is Nothing) Then
MsgBox "There is no Active Model"
End If
Dim HaveExcel
Dim RQ
RQ = vbYes 'MsgBox("Is Excel Installed on your machine ?", vbYesNo + vbInformation, "Confirmation")
If RQ = vbYes Then
HaveExcel = True
' Open & Create Excel Document
Dim x1 '
Set x1 = CreateObject("Excel.Application")
x1.Workbooks.Open "….. \MXSJ.XLSX" '选择你需要读取的EXCEL文件
x1.Workbooks(1).Worksheets("Sheet1").Activate
Else
HaveExcel = False
End If
a x1, mdl
sub a(x1,mdl)
dim rwIndex
dim tableName
dim colname
dim table
dim col
dim count
'on error Resume Next
For rwIndex = 1 To 1000 step 1
With x1.Workbooks(1).Worksheets("Sheet1")
'MsgBox "生成数据表结构共计1 ="+CStr(.Cells(2,2).Value ), vbOK + vbInformation, "表"
If .Cells(rwIndex, 1).Value = "" Then
Exit For
End If
If .Cells(rwIndex, 4).Value = "" Then
set table = mdl.Tables.CreateNew
table.Name = .Cells(rwIndex , 1).Value '表名
table.Code = .Cells(rwIndex , 2).Value '表CODE
table.Comment = .Cells(rwIndex , 3).Value' 表注释
count = count + 1
Else
colName = .Cells(rwIndex, 1).Value
set col = table.Columns.CreateNew
'MsgBox .Cells(rwIndex, 1).Value, vbOK + vbInformation, "列"
'MsgBox col.Name, vbOK + vbInformation, "列"
col.Code = .Cells(rwIndex, 1).Value '字段CODE
col.Name = .Cells(rwIndex, 2).Value '字段NAME
col.Comment = .Cells(rwIndex,3).Value '字段注释
col.DataType = .Cells(rwIndex, 4).Value '字段类型
End If
End With
Next
MsgBox "生成数据表结构共计" + CStr(count), vbOK + vbInformation, "表"
Exit Sub
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
'ceaate by runnerrunning
' get the current active model
Dim mdl ' the current model
Set mdl = ActiveModel
If (mdl Is Nothing) Then
MsgBox "There is no Active Model"
Else
ListObjects(mdl)
End If
'-----------------------------------------------------------------------------
Private Sub ListObjects(fldr) '列出所有的对象
output "Scanning " & fldr.code
Dim obj ' running object
For Each obj In fldr.children
' Calling sub procedure to print out information on the object
TableSetComment obj
Next
' go into the sub-packages
Dim f ' running folder
For Each f In fldr.Packages '递归调用列出所有的对象
'calling sub procedure to scan children package
ListObjects f
Next
End Sub
Private Sub TableSetComment(CurrentObject)
if not CurrentObject.Iskindof(cls_Table) then exit sub
'output "Found "+CurrentObject.ClassName+" """+CurrentObject.Name+""", Created by "+CurrentObject.Creator+" On "+Cstr(CurrentObject.CreationDate)
'output "Found "+CurrentObject.ClassName+" ; "+CurrentObject.Name
if not CurrentObject.isShortcut then
'CurrentObject.Comment = CurrentObject.name &vbCrLf& CurrentObject.Comment
Dim col ' running column
Dim num
Dim cjtime
cjtime=10
if cjtime then
CurrentObject.columns.CreateNewAt(num)
for each col in CurrentObject.columns
'修改新加的那个字段的属性
'if left(col.Name,6)="Column" then
'col.Name="采集时间"
'col.Code="CJ_TIME"
'col.Comment="采集时间"
'col.DataType="DATE"
'end if
next
num=num+1
end if
end if
End Sub
