PowerDesigner直接导出表结构的两种脚本

最新推荐文章于 2024-07-08 23:43:22 发布

原创最新推荐文章于 2024-07-08 23:43:22 发布 · 1.1k 阅读

2 ·

CC 4.0 BY-SA版权

文章标签：

#powerdesigner

本文介绍如何使用PowerDesigner将物理数据模型导出至Excel表格，并提供了两种不同的导出方式：一种包括实体和表信息，另一种仅包含表信息。每种方式都详细展示了VBA代码实现过程。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

步骤

打开PowerDesigner，找到创建的物理模型(Physical Data Model)，
使用快捷键，或者在PowerDesigner菜单栏中，依次点击“Tools ->Excute Commands->Edit/Run Script…”
将下面代码粘贴到空白，点击Run
将导出的结果（Excel）另存为

方式一：实体+表

1. 测试结果

在这里插入图片描述

2. 代码

'******************************************************************************  
'* File:     pdm2excel
'* Title:    pdm export to excel  
'* Purpose:  To export the tables and columns to Excel  
'* Model:    Physical Data Model  
'* Objects:  Table, Column, View  
'* Version:  1.0  
'******************************************************************************  
Option Explicit  
   Dim rowsNum  
   rowsNum = 0  
'-----------------------------------------------------------------------------  
' Main function  
'-----------------------------------------------------------------------------  
' 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  
 ' Get the tables collection  
 '创建EXCEL APP  
 dim beginrow  
 DIM EXCEL, SHEET  
 set EXCEL = CREATEOBJECT("Excel.Application")  
 EXCEL.workbooks.add(-4167)'添加工作表  
 EXCEL.workbooks(1).sheets(1).name ="test"  
 set sheet = EXCEL.workbooks(1).sheets("test")  

 ShowProperties Model, SHEET  
 EXCEL.visible = true  
 '设置列宽和自动换行  
 sheet.Columns(1).ColumnWidth = 20   
 sheet.Columns(2).ColumnWidth = 40   
 sheet.Columns(4).ColumnWidth = 20   
 sheet.Columns(5).ColumnWidth = 20   
 sheet.Columns(6).ColumnWidth = 15   
 sheet.Columns(1).WrapText =true  
 sheet.Columns(2).WrapText =true  
 sheet.Columns(4).WrapText =true  
 End If  
'-----------------------------------------------------------------------------  
' Show properties of tables  
'-----------------------------------------------------------------------------  
Sub ShowProperties(mdl, sheet)  
   ' Show tables of the current model/package  
   rowsNum=0  
   beginrow = rowsNum+1  
   ' For each table  
   output "begin"  
   Dim tab  
   For Each tab In mdl.tables  
      ShowTable tab,sheet  
   Next  
   if mdl.tables.count > 0 then  
        sheet.Range("A" & beginrow + 1 & ":A" & rowsNum).Rows.Group  
   end if  
   output "end"  
End Sub  
'-----------------------------------------------------------------------------  
' Show table properties  
'-----------------------------------------------------------------------------  
Sub ShowTable(tab, sheet)  
   If IsObject(tab) Then  
     Dim rangFlag  
     rowsNum = rowsNum + 1  
      ' Show properties  
      Output "================================"  
      sheet.cells(rowsNum, 1) = "实体名"  
      sheet.cells(rowsNum, 2) =tab.name  
      sheet.cells(rowsNum, 3) = ""  
      sheet.cells(rowsNum, 4) = "表名"  
      sheet.cells(rowsNum, 5) = tab.code  
      sheet.Range(sheet.cells(rowsNum, 5),sheet.cells(rowsNum, 6)).Merge  
      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.Range(sheet.cells(rowsNum-1, 1),sheet.cells(rowsNum, 2)).Borders.LineStyle = "1"  
      sheet.Range(sheet.cells(rowsNum-1, 4),sheet.cells(rowsNum, 6)).Borders.LineStyle = "1"  
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.comment  
        sheet.cells(rowsNum, 3) = ""  
      sheet.cells(rowsNum, 4) = col.name  
      sheet.cells(rowsNum, 5) = col.code  
      sheet.cells(rowsNum, 6) = col.datatype  
      next  
      sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,2)).Borders.LineStyle = "2"         
      sheet.Range(sheet.cells(rowsNum-colsNum+1,4),sheet.cells(rowsNum,6)).Borders.LineStyle = "2"  
      rowsNum = rowsNum + 1  

      Output "FullDescription: "       + tab.Name  
   End If  
End Sub

方式二：表

1. 测试结果

在这里插入图片描述

2. 代码

Option Explicit
   Dim rowsNum
   rowsNum = 0
'-----------------------------------------------------------------------------
' Main function
'-----------------------------------------------------------------------------
' 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
      ' Get the tables collection
      ' 创建EXCEL APP
      dim beginrow
      DIM EXCEL, SHEET, SHEETLIST
      set EXCEL = CREATEOBJECT("Excel.Application")
      EXCEL.workbooks.add(-4167)    ' 添加工作表Sheet1
      EXCEL.workbooks(1).sheets(1).name ="表结构"      'Sheet1名称
      set SHEET = EXCEL.workbooks(1).sheets("表结构")  'Sheet1对象
        
      EXCEL.workbooks(1).sheets.add     ' 添加工作表Sheet2
      EXCEL.workbooks(1).sheets(1).name ="目录"           'Sheet2名称
      set SHEETLIST = EXCEL.workbooks(1).sheets("目录")   'Sheet2对象
      ShowTableList Model,SHEETLIST
  
      ShowProperties Model, SHEET,SHEETLIST
       
            output  "Select: " + EXCEL.workbooks(1).Sheets(2).name         
      EXCEL.workbooks(1).Sheets(2).Select       '选择默认打开的工作表
      EXCEL.visible = true  ' 弹出Excel工作簿
      ' 设置列宽
      sheet.Columns(1).ColumnWidth = 20
      sheet.Columns(2).ColumnWidth = 20
      sheet.Columns(3).ColumnWidth = 20
      sheet.Columns(4).ColumnWidth = 40
      '根据需要添加列数，这里是4列，接着是自动换行
      sheet.Columns(1).WrapText =true
      sheet.Columns(2).WrapText =true
      sheet.Columns(4).WrapText =true
      '不显示网格线
      EXCEL.ActiveWindow.DisplayGridlines = True
 End If
              
'-----------------------------------------------------------------------------
' Show properties of tables
'-----------------------------------------------------------------------------
Sub ShowProperties(mdl, sheet,SheetList)
   ' Show tables of the current model/package
   rowsNum=0
   beginrow = rowsNum+1
   Dim rowIndex ' 为目录Sheet设置链接位置
   rowIndex=3
   ' For each table
   output "表结构 begin ========================"
   Dim tab  ' Power Tables
   For Each tab In mdl.tables
      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 "表结构 end ！"
End Sub
 
'-----------------------------------------------------------------------------
' Show table properties
'-----------------------------------------------------------------------------
Sub ShowTable(tab, sheet,rowIndex,sheetList)
   If IsObject(tab) Then
         
        rowsNum = rowsNum + 1   'rowsNum=1,工作表第一行
        ' Show properties
        Output "：表"+ tab.name +"的结构"
        sheet.cells(rowsNum, 1) =tab.name
        sheet.cells(rowsNum, 1).HorizontalAlignment=3
        sheet.cells(rowsNum, 2) = tab.code
        'sheet.cells(rowsNum, 3) = tab.comment
        'sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 4)).Merge ' 单元格合并
       
        '设置超链接，从目录点击表名去查看表结构
        sheetList.Hyperlinks.Add sheetList.cells(rowIndex,2), "","表结构"&"!B"&rowsNum
         
        '字段名称    字段编码    数据类型    注释   
        rowsNum = rowsNum + 1   'rowsNum=2,工作表第2行
        sheet.cells(rowsNum, 1) = "字段名称"
        sheet.cells(rowsNum, 2) = "字段编码"
        sheet.cells(rowsNum, 3) = "数据类型"
        sheet.cells(rowsNum, 4) = "注释"
        '设置边框
        sheet.Range(sheet.cells(rowsNum-1, 1),sheet.cells(rowsNum, 4)).Borders.LineStyle = "1"
        '字体为10号
        sheet.Range(sheet.cells(rowsNum-1, 1),sheet.cells(rowsNum, 4)).Font.Size=10
        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
            '5是否主键，6约束是否为Null，7默认值
            '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
        next
        sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,4)).Borders.LineStyle = "3"    ' Style3边框线为虚线 
        sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,4)).Font.Size = 10
        rowsNum = rowsNum + 2   ' 表间隔为2行
        
   End If
     
End Sub
 
'-----------------------------------------------------------------------------
' Show List Of Table
'-----------------------------------------------------------------------------
Sub ShowTableList(mdl, SheetList)
   ' Show tables of the current model/package
   Dim rowsNo
   rowsNo=1
   output "目录begin"
   SheetList.cells(rowsNo, 1) = "主题"
   SheetList.cells(rowsNo, 2) = "表名称"
   SheetList.cells(rowsNo, 3) = "表编码"
   SheetList.cells(rowsNo, 4) = "表说明"
   rowsNo = rowsNo + 1
   SheetList.cells(rowsNo, 1) = mdl.name
   ' For each table
   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
     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