PDM与Excel利用VB脚本进行互导
来源：互联网 发布：淘宝网副总裁张勤 编辑：程序博客网 时间：2024/05/17 02:15
1、基础样例表和数据
Excel数据表，样例中有两个sheet。样表及数据如下：
sheet1=>
sheet2=>
截图=>
2、Excel导入到PDM的脚本
Import_PDM_From_Excel.vbs
'******************************************************************************'* Purpose: 从Excel中读取信息创建PDM模型'* Title:'* Category: 创建'* Author: nisj'* Created: 2015年7月31日'* Modified:'* Use: 打开PDM，创建新的PDM，运行本脚本（Ctrl+Shift+X）'* Excel 格式要求'* MODEL Sheet'* |A |B |C |D |E |F |G |H |I |J |K |'* 主题域 |表注释 |表英文名称 |表中文名称 |列名 |列中文名称 |列注释 |数据类型 |主键 |是否为空 |默认值 |'* Version: 1.0'* Comment:'******************************************************************************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 modelDIM mdl ' 定义当前的模型SET mdl = ActiveModel '通过全局参数获得当前的模型IF (mdl IS NOTHING) THEN MsgBox "没有选择模型，请选择一个模型并打开"ELSEIF NOT mdl.IsKindOf(PdPDM.cls_Model) THEN MsgBox "当前选择的不是一个物理模型（PDM）."ELSE'选择需要导入的Excel文件' 打开ExcelDIM xlApp '定义Excel对象SET xlApp = CreateObject("Excel.Application")xlApp.DisplayAlerts = FALSEDIM xlBook '定义Excel SheetSET xlBook = xlApp.WorkBooks.Open("F:\model\model_import.xlsx")xlApp.Visible = TRUEoutput "开始从Excel创建模型"Create_From_Excel(xlBook)output "模型创建完成，开始关闭Excel"SET xlBook=NOTHINGxlApp.QuitSET xlApp=NOTHINGEND IFPRIVATE SUB Create_From_Excel(xlBook) DIM xlsheet DIM rowcount dim pkg FOR EACH xlsheet IN xlBook.WORKSHEETSrowcount = xlsheet.UsedRange.Cells.Rows.Countoutput "本Excel["+xlsheet.name+"]共有行数为:"+CSTR(rowcount)IF rowcount>1 THEN SET pkg = CreateOrReplacePackageByName( xlsheet.name , mdl) Create_Model_From_Excel xlsheet,pkg SET xlsheet=NOTHINGEND IF NEXTEND SUB'--------------------------------------------------------------------------------'功能函数'--------------------------------------------------------------------------------PRIVATE SUB Create_Model_From_Excel(xlsheet,package)DIM Tab '定义数据表对象DIM colDIM tabcodeDIM tabcode1DIM iDIM col_codeFOR i=2 TO xlsheet.UsedRange.Cells.Rows.Count'判断是否需要创建新表对象tabcode1 = xlsheet.Range(CELL_C+CSTR(i)).ValueIF tabcode1<>"" and tabcode<>tabcode1 THENSET Tab=NOTHING tabcode=tabcode1IF tabcode<>"" THEN '判断表是否存在，如果不存在则创建，存在则直接返回表对象SET tab = CreateOrReplaceTableByCode(tabcode,package)'将表的所有列删除,如果需要重新创建表的列IF isclear_columns THENDeleteTableColumns(tab)END IF'更新表的属性Tab.code=xlsheet.Range(CELL_C+CSTR(i)).ValueTab.name=xlsheet.Range(CELL_D+CSTR(i)).ValueTab.comment=xlsheet.Range(CELL_D+CSTR(i)).ValueTab.Description=xlsheet.Range(CELL_B+CSTR(i)).Value '注释'Tab.owner=FindUserByName(str_username)output "创建表模型OK:"+Tab.code+"——"+Tab.nameEND IFEND IFIF 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 '列数据类型'列是否主键，如果是主键，则输出 YIF CSTR(xlsheet.Range(CELL_I+CSTR(i)).Value)=str_iskey THENcol.primary= TRUEEND IFoutput "更新表模型的列OK:"+Tab.code+"——"+col.code+"--"+col.nameEND IFNEXTEND 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, nameEND IFSET CreateOrReplacePackageByName = pkgEND FUNCTIONPRIVATE 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, codeEND IFSET CreateOrReplaceTableByCode = tabEND FUNCTIONPRIVATE 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 , codeEND IFSET CreateOrReplaceColumnByCode = colEND FUNCTIONPRIVATE FUNCTION FindPackageByName(name,model)DIM pkg 'Table 对象SET FindPackageByName = NOTHINGFOR EACH pkg IN model.PackagesIF NOT pkg.isShortcut THENIF pkg.name =name THENSET FindPackageByName=pkgExit FOREND IFEND IFNEXTEND FUNCTIONPRIVATE FUNCTION FindTableByName(name,package)DIM Tab1 'Table 对象SET FindTableByName = NOTHINGFOR EACH Tab1 IN package.TablesIF NOT Tab1.isShortcut THENIF Tab1.name =name THENSET FindTableByName=Tab1Exit FOREND IFEND IFNEXTEND FUNCTIONPRIVATE FUNCTION FindTableByCode(code,package)DIM Tab1 'Table 对象SET FindTableByCode = NOTHINGFOR EACH Tab1 IN package.TablesIF NOT Tab1.isShortcut THEN'OUTPUT "循环表:"+Tab1.nameIF Tab1.code =code THENSET FindTableByCode=Tab1Exit FOREND IFEND IFNEXTEND FUNCTIONPRIVATE FUNCTION FindColumnByCode(code,tabobj)DIM col1 'Column 对象'OUTPUT "code:"+codeSET FindColumnByCode = NOTHINGFOR EACH col1 IN tabobj.Columns'OUTPUT "code2:"+col1.codeIF col1.code =code THENSET FindColumnByCode=col1EXIT FOREND IFNEXTEND FUNCTIONPRIVATE FUNCTION FindColumnByName(name,tabobj)DIM col1 'Column 对象'OUTPUT "codename:"+nameSET FindColumnByName = NOTHINGFOR EACH col1 IN tabobj.ColumnsIF col1.name =name THENSET FindColumnByName=col1EXIT FOREND IFNEXTEND FUNCTIONPRIVATE FUNCTION FindDomainByName(dmname,mdl)DIM dm1 'Domain 对象SET FindDomainByName = NOTHINGFOR EACH dm1 IN mdl.domainsIF NOT dm1.isShortcut THENIF dm1.name =dmname THENSET FindDomainByName =dm1EXIT FOREND IFEND IFNEXTEND FUNCTIONPRIVATE FUNCTION FindUserByName(username)DIM user1SET FindUserByName = NOTHINGFOR EACH user1 IN mdl.usersIF user1.name=username THENSET FindUserByName=user1EXIT FOREND IFNEXTEND 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 IFEND SUB
3、PDM导出成EXCEL的脚本
Export_PDM_To_Excel.vbs
'******************************************************************************'* File: Export_model_to_excel.vbs'* Purpose: 将模型Table等对象的描述信息导出到Excel中'* Title:'* Category: Export'* Author: nisj'* Created: 2015年7月31日'* Modified:'* Use: 打开PDM，创建新的PDM，运行本脚本（Ctrl+Shift+X）'* Excel 格式为'* MODEL Sheet'* |A |B |C |D |E |F |G |H |I |J |K |'* 主题域 |表注释 |表英文名称 |表中文名称 |列名 |列中文名称 |列注释 |数据类型 |主键 |是否为空 |默认值 |'* Version: 1.0'* Comment:'******************************************************************************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 modelSET mdl = ActiveModelIF (mdl IS NOTHING) THEN MsgBox "没有选择一个Model"END IFDIM fldrSET Fldr = ActiveDiagram.ParentDIM isMerage '是否需要合并表名称单元格DIM isMulite '是否不同的Package不同的sheetDIM RQRQ = MsgBox ("是否不同的Package不同的sheet?", vbYesNo + vbInformation,"确认")IF RQ= VbYes THEN isMulite= TRUEELSE isMulite= FALSEEND IF' 创建新的ExcelDIM x1 'SET x1 = CreateObject("Excel.Application")x1.Workbooks.Addx1.Visible = TRUEExportModelToExcel( 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.MergeEND 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 nb = nb+1 '行号加1 NEXT END IF NEXT '对子包进行递归，如果不使用递归只能取到第一个模型图内的表 DIM subfolder FOR EACH subfolder IN folder.Packages ExportModelToExcel(subfolder) NEXTEND FUNCTION'--------------------------------------------------------------------------------'功能函数:添加一个Sheet页'--------------------------------------------------------------------------------PRIVATE SUB AddExcelSheet(sheetname) x1.Sheets.Add x1.ActiveSheet.Name=sheetnameEND 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 = TRUEEND SUB
4、Excel直接生成建库脚本的VB
在Excel中，主要通过如下的菜单找到写宏执行宏的地方：
文件-->选项-->自定义功能区-->自定义功能区（主选项卡）-->勾选"开发工具"；然后到开发工具主菜单中，开发工具-->宏-->进行新建和执行。
From_Excel_model_generate_sql.txt
Sub create_all_sheet_sql()Dim xlsheetFor Each xlsheet In ThisWorkbook.Worksheets Create_SQL xlsheet.Name, "F:\model\"NextEnd SubSub Create_SQL(sheetName, outputPath)Dim strPath As StringDim RowCount As IntegerDim xlsheet_srcDim strSQL As StringDim hasCreat As IntegerDim strTable1 As StringDim strTable As StringDim strTableComm As StringDim strField As StringDim strFieldComm As StringDim strType As StringDim strKey As String' 请根据实际情况修改下面3个值'sheetName = "1-核心表" '要生成SQL的Sheet页的名称strPath = outputPath + sheetName + ".sql" '"d:\2001.sql" '生成的SQL文件Set xlsheet_src = ThisWorkbook.Worksheets(sheetName)RowCount = xlsheet_src.UsedRange.Cells.Rows.Count '得到此Sheet的行数hasCreat = 0'生成表的建表语句For i = 2 To RowCount + 1 strTable1 = xlsheet_src.Range("C" + CStr(i)).Value If strTable <> strTable1 Then If hasCreat = 1 Then strSQL = ");" ret = sWriteFile(strSQL, strPath) strSQL = "" hasCreat = 0 End If strTable = strTable1 If (strTable <> "") Then strTableComm = xlsheet_src.Range("D" + CStr(i)).Value strSQL = "DROP TABLE " & strTable & ";" & vbCrLf & "CREATE TABLE " & strTable & "( " & " -- " & strTableComm ret = sWriteFile("", strPath) ret = sWriteFile(strSQL, strPath) intRow = 1 hasCreat = 1 End If End If If strTable <> "" Then strField = xlsheet_src.Range("E" + CStr(i)).Value strFieldComm = xlsheet_src.Range("F" + CStr(i)).Value strType = xlsheet_src.Range("H" + CStr(i)).Value If strField <> "" Then If intRow = 1 Then strSQL = " " & strField & " " & strType & " -- " & strFieldComm Else strSQL = " ," & strField & " " & strType & " -- " & strFieldComm End If ret = sWriteFile(strSQL, strPath) intRow = intRow + 1 End If End If Next'生成表的comment语句For i = 2 To RowCount strTable1 = xlsheet_src.Range("C" + CStr(i)).Value If strTable1 <> "" Then If strTable <> strTable1 Then strTable = strTable1 strTableComm = xlsheet_src.Range("D" + CStr(i)).Value strSQL = "comment on table " & strTable & " is '" & strTableComm & "';" ret = sWriteFile("", strPath) ret = sWriteFile(strSQL, strPath) intRow = 1 hasCreat = 1 End If End If If strTable <> "" Then strField = xlsheet_src.Range("E" + CStr(i)).Value strFieldComm = xlsheet_src.Range("F" + CStr(i)).Value strType = xlsheet_src.Range("H" + CStr(i)).Value If strField <> "" Then strSQL = "comment on column " & strTable & "." & strField & " is '" & strFieldComm & "';" ret = sWriteFile(strSQL, strPath) intRow = intRow + 1 End If End If NextEnd SubFunction sWriteFile(strSQL As String, strFullFileName As String) Dim intFileNum As String intFileNum = FreeFile Open strFullFileName For Append As #intFileNum Print #intFileNum, strSQL Close #intFileNumEnd Function
0 0
- PDM与Excel利用VB脚本进行互导
- 利用excel生成pdm表结构
- excel表结构通过vb导入到pdm里
- VB与EXCEL
- VB与EXCEL
- excel转换成pdm
- excel转换成pdm
- pdm转excel
- PDM转EXCEL
- powerdesigner转excel的VB脚本
- VB 利用ADO的Stream对象在数据库进行写入与读出
- 利用VB驱动pcAnyWhere进行自动文件传输
- VB 利用WMI进行日志监视
- VB 利用WMI进行进程监视
- VB 利用WMI进行USB监视
- VB 利用WMI进行PNP监视
- VB 利用WMI进行服务监视
- VB中利用WinRAR进行文件压缩
- 直接用socket实现HTTP下载
- mysql_fetch_array容易掉入的陷进
- 黑马程序员——走进面向对象
- NGUI（三）背包系统页面
- hdu 5298 Solid Geometry Homework（几何）
- PDM与Excel利用VB脚本进行互导
- ubuntu下搭建rust到intellij开发环境
- XML基本知识
- API注册表函数
- hdu 5299 Circles Game（博弈）
- 翻转子串
- oc构造方法
- 创建Struts2项目
- KMP算法
