通过VB脚本实现PDM与EXCEL互转

最新推荐文章于 2023-04-05 15:03:04 发布

Aikes902

最新推荐文章于 2023-04-05 15:03:04 发布

阅读量1k

点赞数 2

分类专栏： Common 文章标签： Power Designer 物理数据模型 VB Excel PDM

本文链接：https://blog.csdn.net/AikesLs/article/details/99978948

版权

Common 专栏收录该内容

12 篇文章 0 订阅

订阅专栏

在软件开发过程中，很多时候都需要用需求文档中给出的表结构进行数据建模。若表数量、单位表字段数量较少还可以接受，一旦遇到十几张大表真的是心力交瘁。

以下是本人整理改进后的两套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

Aikes902

关注

2
点赞
踩
5

收藏

觉得还不错? 一键收藏
打赏
0
评论
通过VB脚本实现PDM与EXCEL互转

在软件开发过程中，很多时候都需要用需求文档中给出的表结构进行数据建模。若表数量、单位表字段数量较少还可以接受，一旦遇到十几张大表真的是心力交瘁。以下是本人整理改进后的两套VBS脚本，通过Power Designer工具中Script命令行执行脚本，实现PDM与Excel之间的模型互转，希望可以帮到大家！Excel格式样例：Excel -> PD...
复制链接

扫一扫