PowerDesigner 数据模型导入导出 Excel

目录

导出

数据模型导出成 Excel

导入

Excel 导入成数据模型

附：PowerDesigner16.5 安装包地址

链接：https://pan.baidu.com/s/1-JC2QF727OVW7U1zdiGd3A 
提取码：zam6

---

导出

数据模型导出成 Excel

最近项目组正在整理开发流程规范，其中对于数据库的管理个人整理如下。

先看一眼效果图：

数据库物理表输入输出要素.xlsx

实现如上效果，需执行一段 VBScript 脚本，网上借鉴了一些 ，根据自己的需求我又重新写了一下，如下：

执行路径【Tools - Execute Command - Run Script】或者快捷键【Ctrl + Shift + X】，点击运行：

'****************************************************************************** 
'* Title:    pdm export to excel 
'* Describe:  To export the tables and columns to Excel 
'* Model:    Physical Data Model 
'* Objects:  Table, Column, View 
'* Author:   baicun 
'* Created:  2018-10-18 
'* Version:  1.0 
'******************************************************************************
Option Explicit
   Dim rowsNum
   rowsNum = 0
'-----------------------------------------------------------------------------
' Main function
'-----------------------------------------------------------------------------
' 定义 Model 变量,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
      ' 定义变量,创建EXCEL APP
      DIM beginrow
      DIM EXCEL, SHEET, SHEETLIST, INDEXLIST
      set EXCEL = CREATEOBJECT("Excel.Application")
      EXCEL.workbooks.add(-4167)'添加工作表
      EXCEL.workbooks(1).sheets(1).name ="数据库表清单"
      set SHEET = EXCEL.workbooks(1).sheets("数据库表清单")
      
      EXCEL.workbooks(1).sheets.add
      EXCEL.workbooks(1).sheets(1).name ="数据库表要素"
      set SHEETLIST = EXCEL.workbooks(1).sheets("数据库表要素")
      
      EXCEL.workbooks(1).sheets.add
      EXCEL.workbooks(1).sheets(1).name ="索引清单"
      set INDEXLIST = EXCEL.workbooks(1).sheets("索引清单")
      
      ' 索引清单 sheet
      IndexProperties Model
      ' 数据库表清单 sheet
      ShowTableList Model,SHEETLIST
      ' 数据库表要素 sheet
      ShowProperties Model, SHEET,SHEETLIST
            
      EXCEL.workbooks(1).Sheets(3).Select
      EXCEL.visible = true
      '设置列宽和自动换行
      sheet.Columns(1).ColumnWidth = 20 
      sheet.Columns(2).ColumnWidth = 20 
      sheet.Columns(3).ColumnWidth = 20 
      sheet.Columns(4).ColumnWidth = 40 
      sheet.Columns(5).ColumnWidth = 10 
      sheet.Columns(6).ColumnWidth = 10 
      sheet.Columns(1).WrapText =true
      sheet.Columns(2).WrapText =true
      sheet.Columns(4).WrapText =true
      '不显示网格线
      'EXCEL.ActiveWindow.DisplayGridlines = False
      
      
 End If
'-----------------------------------------------------------------------------
' Show properties of 数据库表清单 sheet
'-----------------------------------------------------------------------------
Sub ShowProperties(mdl, sheet,SheetList)
   ' Show tables of the current model/package
   rowsNum=0
   beginrow = rowsNum+1
   Dim rowIndex 
   rowIndex=3
   ' For each table
   output "export begin "
      
   Dim tab
   For Each tab In mdl.tables

   If rowsNum = 0 Then
   		rowsNum = rowsNum + 1
   		sheet.cells(rowsNum, 1) = "字段中文名"
      sheet.cells(rowsNum, 2) = "字段英文名"
      sheet.cells(rowsNum, 3) = "字段类型"
      sheet.cells(rowsNum, 4) = "字段描述"
      sheet.cells(rowsNum, 5) = "是否主键"
      sheet.cells(rowsNum, 6) = "是否非空"
      sheet.cells(rowsNum, 7) = "默认值"
      sheet.cells(rowsNum, 8) = "字典编号"
      sheet.cells(rowsNum, 9) = "表英文名"
      sheet.cells(rowsNum, 10) = "表中文名"
     End If 
      ShowTable tab,sheet,rowIndex,sheetList
      rowIndex = rowIndex +1
   Next
   if mdl.tables.count > 0 then
        sheet.Range("A" & beginrow + 1 & ":A" & rowsNum).Rows.Group
   end if
   output "export end "
End Sub
'-----------------------------------------------------------------------------
' Show 数据库表清单 sheet properties
'-----------------------------------------------------------------------------
Sub ShowTable(tab, sheet,rowIndex,sheetList)
   If IsObject(tab) Then
     Dim rangFlag
      ' Show properties
      Output "================================"
      '设置超链接，从数据库表清单点击表名去查看数据库表要素
      'sheetList.Hyperlinks.Add sheetList.cells(rowIndex,2), "","数据库表清单"&"!B"&rowsNum
      
      '设置边框
      'sheet.Range(sheet.cells(rowsNum-1, 2),sheet.cells(rowsNum, 7)).Borders.LineStyle = "1"
      'sheet.Range(sheet.cells(rowsNum-1, 4),sheet.cells(rowsNum, 9)).Borders.LineStyle = "1"
      '字体为11号
      'sheet.Range(sheet.cells(rowsNum-1, 1),sheet.cells(rowsNum, 7)).Font.Size=11
            Dim col ' running column
            Dim colsNum
            colsNum = 0
      for each col in tab.columns
        rowsNum = rowsNum + 1
        colsNum = colsNum + 1
          sheet.cells(rowsNum, 1) = col.name
          sheet.cells(rowsNum, 2) = col.code
          sheet.cells(rowsNum, 3) = col.datatype
        sheet.cells(rowsNum, 4) = col.comment
          If col.Primary = true Then
        sheet.cells(rowsNum, 5) = "Y" 
        Else
        sheet.cells(rowsNum, 5) = " " 
        End If
        If col.Mandatory = true Then
        sheet.cells(rowsNum, 6) = "Y" 
        Else
        sheet.cells(rowsNum, 6) = " " 
        End If
        sheet.cells(rowsNum, 7) =  col.defaultvalue
        sheet.cells(rowsNum, 8) = ""
        sheet.cells(rowsNum, 9) = tab.code
      	sheet.cells(rowsNum, 10) = tab.name
      next
      'sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,7)).Borders.LineStyle = "3"       
      'sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,7)).Font.Size = 11
      
      Output "FullDescription: " + tab.Name
   End If
   
End Sub
'-----------------------------------------------------------------------------
' Show List Of Table
'-----------------------------------------------------------------------------
Sub ShowTableList(mdl, SheetList)
   ' Show tables of the current model/package
   Dim rowsNo
   rowsNo=1
   ' 设置 sheet 内字段值
   output "sheet begin "
   SheetList.cells(rowsNo, 1) = "数据库"
   SheetList.cells(rowsNo, 2) = "表中文名"
   SheetList.cells(rowsNo, 3) = "表英文名"
   SheetList.cells(rowsNo, 4) = "表说明"
   SheetList.cells(rowsNo, 5) = "更新日期"
   SheetList.cells(rowsNo, 6) = "更新用户"
   rowsNo = rowsNo + 1
   ' 设置 sheet 名称
   SheetList.cells(rowsNo, 1) = mdl.name
   Dim tab
   For Each tab In mdl.tables
     If IsObject(tab) Then
         rowsNo = rowsNo + 1
      SheetList.cells(rowsNo, 1) = ""
      SheetList.cells(rowsNo, 2) = tab.name
      SheetList.cells(rowsNo, 3) = tab.code
      SheetList.cells(rowsNo, 4) = tab.comment
      SheetList.cells(rowsNo, 5) = ""
      SheetList.cells(rowsNo, 6) = ""
     End If
   Next
    SheetList.Columns(1).ColumnWidth = 20 
      SheetList.Columns(2).ColumnWidth = 20 
      SheetList.Columns(3).ColumnWidth = 30 
     SheetList.Columns(4).ColumnWidth = 60 
   output "end"
End Sub
'-----------------------------------------------------------------------------
' Show Index Of Table
'-----------------------------------------------------------------------------
Sub IndexProperties(mdl)
   ' Show tables of the current model/package
   rowsNum=0
   beginrow = rowsNum+1
   Dim rowIndex 
   rowIndex=3
   Dim idx
   
   For Each idx In mdl.tables
   If rowsNum = 0 Then
   		rowsNum = rowsNum + 1
   		sheet.cells(rowsNum, 1) = "数据库"    
      sheet.cells(rowsNum, 2) = "所属表空间"  
      sheet.cells(rowsNum, 3) = "数据库表"   
      sheet.cells(rowsNum, 4) = "索引名"    
      sheet.cells(rowsNum, 5) = "所属字段名"  
      sheet.cells(rowsNum, 6) = "更新日期"   
      sheet.cells(rowsNum, 7) = "更新用户"
    End If 
      'IndexTable idx
      'rowIndex = rowIndex +1
    Next
   output "end"
End Sub

执行完成后，可以自己做一个差异化的编辑。

数据字典 .xlsx

 

导入

Excel 导入成数据模型

 

 

 

 

以上两个脚本分别以后缀名称为“.vbs”的方式保存；

注意：导出 excel 文件，打开时发现同时打开俩个文件，一个名为 Sheet1 ,解决方案：如下链接。

https://blog.csdn.net/sinat_34104446/article/details/80210424#3.2%20WPS%E8%A7%A3%E5%86%B3%E6%AD%A5%E9%AA%A4

如果上面的方法还没有解决，请换台电脑或者重启电脑试一下。

 脚本借鉴大佬链接如下：

https://www.cnblogs.com/chenz/articles/3456340.html