通过VB脚本实现PDM与EXCEL互转
在软件开发过程中，很多时候都需要用需求文档中给出的表结构进行数据建模。若表数量、单位表字段数量较少还可以接受，一旦遇到十几张大表真的是心力交瘁。
以下是本人整理改进后的两套VBS脚本，通过Power Designer工具中Script命令行执行脚本，实现PDM与Excel之间的模型互转，希望可以帮到大家！
Excel格式样例：
Excel -> PDM
'******************************************************************************
'* Purpose: 从Excel中读取信息创建PDM模型
'* Title:
'* Category:
'* Author: nisj https://blog.csdn.net/nisjlvhudy/article/details/47176981
'* Created: 2015年7月31日
'* Use: 打开PDM，创建新的PDM，运行本脚本（Ctrl+Shift+X）
'* Excel 格式要求
'* |A |B |C |D |E |F |G |H |I |J |K |
'* 主题域 |表注释 |表英文名称 |表中文名称 |列名 |列中文名称 |列注释 |数据类型 |主键 |是否为空 |默认值 |
'* Version: 2.0
'*
'* Comment: Modified By Aikes On 2019-08-21
'*
'******************************************************************************
Option Explicit
' Model sheet中的列信息
CONST CELL_A="A" '主题域(Pachage)
CONST CELL_B="B" '表注释
CONST CELL_C="C" '表英文名称
CONST CELL_D="D" '表中文名称
CONST CELL_E="E" '列名
CONST CELL_F="F" '列中文名称
CONST CELL_G="G" '列注释
CONST CELL_H="H" '数据类型
CONST CELL_I="I" '是否主键
CONST CELL_J="J" '是否可空
CONST CELL_K="K" '默认值
CONST str_iskey="Y"
'表的所属者
CONST str_username="srv"
CONST isclear_columns = true '是否先删除表的所有列，如果是false则不会删除excel中没有的列，如果是true，则会重新创建相应表的所有列
' get the current active model
DIM mdl ' 定义当前的模型
SET mdl = ActiveModel '通过全局参数获得当前的模型
IF (mdl IS NOTHING) THEN
MsgBox "没有选择模型，请选择一个模型并打开"
ELSEIF NOT mdl.IsKindOf(PdPDM.cls_Model) THEN
MsgBox "当前选择的不是一个物理模型（PDM）."
ELSE
'选择需要导入的Excel文件
' 打开Excel
DIM xlApp '定义Excel对象
SET xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = FALSE
DIM xlBook '定义Excel Sheet
SET xlBook = xlApp.WorkBooks.Open("E:\import.xlsx")
xlApp.Visible = TRUE
output "开始从Excel创建模型"
Create_From_Excel(xlBook)
output "模型创建完成，开始关闭Excel"
SET xlBook=NOTHING
xlApp.Quit
SET xlApp=NOTHING
END IF
PRIVATE SUB Create_From_Excel(xlBook)
DIM xlsheet
DIM rowcount
dim pkg
FOR EACH xlsheet IN xlBook.WORKSHEETS
rowcount = xlsheet.UsedRange.Cells.Rows.Count
output "本Excel["+xlsheet.name+"]共有行数为:"+CSTR(rowcount)
IF rowcount>1 THEN
'删掉包概念 可以根据所需自行调整 Modify By Aikes
'SET pkg = CreateOrReplacePackageByName( xlsheet.name , mdl)
Create_Model_From_Excel xlsheet,mdl
SET xlsheet=NOTHING
END IF
NEXT
END SUB
'--------------------------------------------------------------------------------
'功能函数
'--------------------------------------------------------------------------------
PRIVATE SUB Create_Model_From_Excel(xlsheet,package)
DIM Tab '定义数据表对象
DIM col
DIM tabcode
DIM tabcode1
DIM i
DIM col_code
FOR i=2 TO xlsheet.UsedRange.Cells.Rows.Count
'判断是否需要创建新表对象
tabcode1 = xlsheet.Range(CELL_C+CSTR(i)).Value
IF tabcode1<>"" and tabcode<>tabcode1 THEN
SET Tab=NOTHING
tabcode=tabcode1
IF tabcode<>"" THEN
'判断表是否存在，如果不存在则创建，存在则直接返回表对象
SET tab = CreateOrReplaceTableByCode(tabcode,package)
'将表的所有列删除,如果需要重新创建表的列
IF isclear_columns THEN
DeleteTableColumns(tab)
END IF
'更新表的属性
Tab.code=xlsheet.Range(CELL_C+CSTR(i)).Value
Tab.name=xlsheet.Range(CELL_D+CSTR(i)).Value
Tab.comment=xlsheet.Range(CELL_D+CSTR(i)).Value
Tab.Description=xlsheet.Range(CELL_B+CSTR(i)).Value '注释
'Tab.owner=FindUserByName(str_username)
output "创建表模型OK:"+Tab.code+"——"+Tab.name
END IF
END IF
IF NOT(Tab IS NOTHING) THEN '创建表的列
col_code=xlsheet.Range(CELL_E+CSTR(i)).Value '列代码
'判断是否已经存在列,不存在则创建
SET col = CreateOrReplaceColumnByCode(col_code,Tab)
'设置列属性
col.code=xlsheet.Range(CELL_E+CSTR(i)).Value '列代码
col.name=xlsheet.Range(CELL_F+CSTR(i)).Value '列名称
col.comment=xlsheet.Range(CELL_F+CSTR(i)).Value '列注释
col.Description=xlsheet.Range(CELL_G+CSTR(i)).Value '列注释
col.DataType=xlsheet.Range(CELL_H+CSTR(i)).Value '列数据类型
'列是否主键，如果是主键，则输出 Y
IF CSTR(xlsheet.Range(CELL_I+CSTR(i)).Value)=str_iskey THEN
col.primary= TRUE
END IF
'补充 J-是否为空标记、K-默认值 若已标记主键非空约束自动存在 不需要再次标记 Added By Aikes
IF CSTR(xlsheet.Range(CELL_J+CSTR(i)).Value)=str_iskey and col.primary <> TRUE THEN
col.Mandatory= TRUE '是否为空标记
END IF
col.DefaultValue=xlsheet.Range(CELL_K+CSTR(i)).Value '默认值
output "更新表模型的列OK:"+Tab.code+"——"+col.code+"--"+col.name
END IF
NEXT
END SUB
'--------------------------------------------------------------------------------
'功能函数
'--------------------------------------------------------------------------------
PRIVATE FUNCTION CreateOrReplacePackageByName(name,model)
DIM pkg 'Table 对象
SET pkg = FindPackageByName(name,model)
IF pkg IS NOTHING THEN
SET pkg = model.Packages.CreateNew()
pkg.SetNameAndCode name, name
pkg.PhysicalDiagrams.Item(0).SetNameAndCode name, name
END IF
SET CreateOrReplacePackageByName = pkg
END FUNCTION
PRIVATE FUNCTION CreateOrReplaceTableByCode(code,package)
DIM tab 'Table 对象
SET tab = FindTableByCode(code,package)
IF tab IS NOTHING THEN
SET tab = package.Tables.CreateNew()
tab.SetNameAndCode code, code
END IF
SET CreateOrReplaceTableByCode = tab
END FUNCTION
PRIVATE FUNCTION CreateOrReplaceColumnByCode(code,table)
DIM col 'Table 对象
SET col =FindColumnByCode(code,table)
IF col IS NOTHING THEN
SET col =table.Columns.CreateNew
col.SetNameAndCode code , code
END IF
SET CreateOrReplaceColumnByCode = col
END FUNCTION
PRIVATE FUNCTION FindPackageByName(name,model)
DIM pkg 'Table 对象
SET FindPackageByName = NOTHING
FOR EACH pkg IN model.Packages
IF NOT pkg.isShortcut THEN
IF pkg.name =name THEN
SET FindPackageByName=pkg
Exit FOR
END IF
END IF
NEXT
END FUNCTION
PRIVATE FUNCTION FindTableByName(name,package)
DIM Tab1 'Table 对象
SET FindTableByName = NOTHING
FOR EACH Tab1 IN package.Tables
IF NOT Tab1.isShortcut THEN
IF Tab1.name =name THEN
SET FindTableByName=Tab1
Exit FOR
END IF
END IF
NEXT
END FUNCTION
PRIVATE FUNCTION FindTableByCode(code,package)
DIM Tab1 'Table 对象
SET FindTableByCode = NOTHING
FOR EACH Tab1 IN package.Tables
IF NOT Tab1.isShortcut THEN
'OUTPUT "循环表:"+Tab1.name
IF Tab1.code =code THEN
SET FindTableByCode=Tab1
Exit FOR
END IF
END IF
NEXT
END FUNCTION
PRIVATE FUNCTION FindColumnByCode(code,tabobj)
DIM col1 'Column 对象
'OUTPUT "code:"+code
SET FindColumnByCode = NOTHING
FOR EACH col1 IN tabobj.Columns
'OUTPUT "code2:"+col1.code
IF col1.code =code THEN
SET FindColumnByCode=col1
EXIT FOR
END IF
NEXT
END FUNCTION
PRIVATE FUNCTION FindColumnByName(name,tabobj)
DIM col1 'Column 对象
'OUTPUT "codename:"+name
SET FindColumnByName = NOTHING
FOR EACH col1 IN tabobj.Columns
IF col1.name =name THEN
SET FindColumnByName=col1
EXIT FOR
END IF
NEXT
END FUNCTION
PRIVATE FUNCTION FindDomainByName(dmname,mdl)
DIM dm1 'Domain 对象
SET FindDomainByName = NOTHING
FOR EACH dm1 IN mdl.domains
IF NOT dm1.isShortcut THEN
IF dm1.name =dmname THEN
SET FindDomainByName =dm1
EXIT FOR
END IF
END IF
NEXT
END FUNCTION
PRIVATE FUNCTION FindUserByName(username)
DIM user1
SET FindUserByName = NOTHING
FOR EACH user1 IN mdl.users
IF user1.name=username THEN
SET FindUserByName=user1
EXIT FOR
END IF
NEXT
END FUNCTION
' 删除表的所有列
PRIVATE SUB DeleteTableColumns(table)
IF NOT table.isShortcut THEN
DIM col
FOR EACH col IN table.columns
'output "Column deleted :"+table.name
col.Delete
SET col = NOTHING
NEXT
END IF
END SUB
PDM - > Excel
'******************************************************************************
'* Purpose: 将模型Table等对象的描述信息导出到Excel中
'* Title:
'* Category: Export
'* Author: nisj https://blog.csdn.net/nisjlvhudy/article/details/47176981
'* Created: 2015年7月31日
'* Use: 打开PDM，创建新的PDM，运行本脚本（Ctrl+Shift+X）
'* Excel 格式为
'* |A |B |C |D |E |F |G |H |I |J |K |
'* 主题域 |表注释 |表英文名称 |表中文名称 |列名 |列中文名称 |列注释 |数据类型 |主键 |是否为空 |默认值 |
'*
'* Version: 2.0
'*
'* Comment: Modified By Aikes On 2019-08-21
'*
'******************************************************************************
Option Explicit
' Model sheet中的列信息
CONST CELL_A="A" '主题域(Pachage)
CONST CELL_B="B" '表注释
CONST CELL_C="C" '表英文名称
CONST CELL_D="D" '表中文名称
CONST CELL_E="E" '列名
CONST CELL_F="F" '列中文名称
CONST CELL_G="G" '列注释
CONST CELL_H="H" '数据类型
CONST CELL_I="I" '是否主键
CONST CELL_J="J" '是否可空
CONST CELL_K="K" '默认值
CONST str_iskey="Y"
DIM nb
'
' get the current active model
'
DIM mdl ' the current model
SET mdl = ActiveModel
IF (mdl IS NOTHING) THEN
MsgBox "没有选择一个Model"
END IF
DIM fldr
SET Fldr = ActiveDiagram.Parent
DIM isMerage '是否需要合并表名称单元格
DIM isMulite
isMulite = FALSE '是否不同的Package不同的sheet
DIM RQ
'RQ = MsgBox ("是否不同的Package不同的sheet?", vbYesNo + vbInformation,"确认")
'IF RQ= VbYes THEN
' isMulite= TRUE
'ELSE
' isMulite= FALSE
'END IF
' 创建新的Excel
DIM x1 '
SET x1 = CreateObject("Excel.Application")
x1.Workbooks.Add
x1.Visible = TRUE
ExportModelToExcel( fldr)
MsgBox "成功将 Models 导出到Excel中！"
'--------------------------------------------------------------------------------
'功能函数:将模型导出到Sheet页【 MODEL 】
'--------------------------------------------------------------------------------
PRIVATE FUNCTION ExportModelToExcel(folder)
'如果是每个package导出到不同的sheet页面，则采用folder的名称作为sheet页名称，否则使用"MODEL"作为sheet页名称
IF isMulite THEN
IF folder.Tables.count>0 THEN
AddExcelSheet(folder.name)
END IF
ELSE
AddExcelSheet("MODEL")
END IF
'写sheet页的第一行表头
WriteExcelModelHead
DIM nStart
DIM nEnd
DIM tabobj '定义数据表对象
nb=2
isMerage=TRUE
'开始循环处理所有的folder
FOR EACH tabobj IN folder.Tables
IF NOT tabobj.isShortcut THEN '快捷方式不处理
'合并表的单元格A、B、C
IF isMerage THEN '合并表的单元格A、B、C
nStart=nb '合并起始行
nEnd=nb+tabobj.Columns.count-1 '合并结束行
IF nStart<>nEnd THEN
'合并单元格
x1.Range(CELL_A+CSTR(nStart)+":"+CELL_A+CSTR(nEnd)).SELECT
x1.Selection.Merge
x1.Range(CELL_B+CSTR(nStart)+":"+CELL_B+CSTR(nEnd)).SELECT
x1.Selection.Merge
END IF
'将主题域、表名称、表注释填写到合并后单元格中
x1.Range(CELL_A+CSTR(nb)).Value = folder.name '主题域
x1.Range(CELL_B+CSTR(nb)).Value = Rtf2Ascii(tabobj.description) '表注释
END IF
'开始循环列兵输出信息
DIM colobj '定义列对象
FOR EACH colobj IN tabobj.Columns
'写表的信息
x1.Range(CELL_C+CSTR(nb)).Value = tabobj.code '表英文名称
x1.Range(CELL_D+CSTR(nb)).Value = tabobj.name '表英文名称
'写列的信息
x1.Range(CELL_E+CSTR(nb)).Value = colobj.code '列名
x1.Range(CELL_F+CSTR(nb)).Value = colobj.name '列中文名称
x1.Range(CELL_G+CSTR(nb)).Value = Rtf2Ascii(colobj.Description) '列注释
x1.Range(CELL_H+CSTR(nb)).Value = colobj.DataType '数据类型
'列是否主键，如果是主键，则输出 Y
IF colobj.primary THEN
x1.Range(CELL_I+CSTR(nb)).Value = "Y"
END IF
'补充是否为空、默认值两列 Modify By Aikes
'列是否允许为空，则输出 Y
IF colobj.Mandatory THEN
x1.Range(CELL_J+CSTR(nb)).Value = "Y"
END IF
x1.Range(CELL_K+CSTR(nb)).Value = colobj.DefaultValue '默认值
nb = nb+1 '行号加1
NEXT
END IF
NEXT
'对子包进行递归，如果不使用递归只能取到第一个模型图内的表
DIM subfolder
FOR EACH subfolder IN folder.Packages
ExportModelToExcel(subfolder)
NEXT
END FUNCTION
'--------------------------------------------------------------------------------
'功能函数:添加一个Sheet页
'--------------------------------------------------------------------------------
PRIVATE SUB AddExcelSheet(sheetname)
x1.Sheets.Add
x1.ActiveSheet.Name=sheetname
END SUB
'--------------------------------------------------------------------------------
'功能函数:写Excel的第一行信息
'--------------------------------------------------------------------------------
PRIVATE SUB WriteExcelModelHead()
x1.Range(CELL_A+"1").Value = "主题域"
x1.Range(CELL_B+"1").Value = "表注释"
x1.Range(CELL_C+"1").Value = "表英文名称"
x1.Range(CELL_D+"1").Value = "表中文名称"
x1.Range(CELL_E+"1").Value = "列名"
x1.Range(CELL_F+"1").Value = "列中文名称"
x1.Range(CELL_G+"1").Value = "列注释"
x1.Range(CELL_H+"1").Value = "数据类型"
x1.Range(CELL_I+"1").Value = "主键"
x1.Range(CELL_J+"1").Value = "是否为空"
x1.Range(CELL_K+"1").Value = "默认值"
'设置字体
x1.Columns(CELL_A+":"+CELL_K).SELECT
WITH x1.Selection.Font
.Name = "宋体"
.Size = 10
END WITH
'设置首行可过滤,背景颜色为灰色,字体粗体
x1.Range(CELL_A+"1:"+CELL_K+"1").SELECT
x1.Selection.AutoFilter
x1.Selection.Interior.ColorIndex = 15
x1.Selection.Font.Bold = TRUE
'设定首行固定
x1.Range(CELL_A+"2").SELECT
x1.ActiveWindow.FreezePanes = TRUE
END SUB