PowerDesigner数据结构导出工具类

第一种方式

'******************************************************************************
'* File:     pdm2excel.txt
'* Title:    pdm export to excel
'* Purpose:  To export the tables and columns to Excel
'* Model:    Physical Data Model
'* Objects:  Table, Column, View
'* Author:   ziyan
'* Created:  2012-05-03
'* 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

第二种方式

'******************************************************************************
'* 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 model
SET mdl = ActiveModel
IF (mdl IS NOTHING) THEN
   MsgBox "没有选择一个Model"
END IF

DIM fldr
SET Fldr = ActiveDiagram.Parent

DIM isMerage '是否需要合并表名称单元格
DIM isMulite '是否不同的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

        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

使用步骤

在PowerDesigner中，使用快捷键Ctrl+Shift+X然后把上面的两个工具类中的任意一个，粘贴进去，点击run就行。