Powerdesigner 导出表结构到excel

网上百度到两种比较好的方法在此记录一下,导出excel有目录:

操作步骤:

点击工具→Execute Commands → Edit/Run Script...或者打开powerdesigner ctrl+shift+x,会弹出代码框

代码框示例

 

 

①如果表没有注释不会导出中文名称

例如下图这种表名或者字段没有注释的话就不会导出中文名称;有注释就会导出注释

 

'******************************************************************************
​
'* File:   Exported_Excel_page.vbs
​
'* Purpose: 分目录递归，查找当前PDM下所有表，并导出Excel
​
'******************************************************************************
​
 
​
Option Explicit
​
ValidationMode = True
​
InteractiveMode = im_Batch
​
 
​
'-----------------------------------------------------------------------------
​
' 主函数
​
'-----------------------------------------------------------------------------
​
' 获取当前活动模型
​
Dim mdl ' 当前的模型
​
Set mdl = ActiveModel
​
Dim EXCEL,catalog,sheet,catalogNum,rowsNum,linkNum
​
rowsNum = 1
​
catalogNum = 1
​
linkNum = 1
​
 
​
If (mdl Is Nothing) Then
​
  MsgBox "There is no Active Model"
​
Else
​
  SetCatalog
​
  ListObjects(mdl)
​
End If
​
 
​
'----------------------------------------------------------------------------------------------
​
' 子过程，用于扫描当前包并从当前包中打印对象的信息，然后对当前包的所有子包再次调用相同的子过程
​
'----------------------------------------------------------------------------------------------
​
Private Sub ListObjects(fldr)
​
  output "Scanning " & fldr.code
​
  Dim obj ' 运行对象
​
  For Each obj In fldr.children
​
    ' 调用子过程来打印对象上的信息
​
    DescribeObject obj
​
  Next
​
  ' 进入子包
​
  Dim f ' 运行文件夹
​
  For Each f In fldr.Packages
​
    '调用子程序扫描子程序包
​
    ListObjects f
​
  Next
​
End Sub
​
 
​
'-----------------------------------------------------------------------------
​
' 子过程，用于在输出中打印当前对象的信息
​
'-----------------------------------------------------------------------------
​
Private Sub DescribeObject(CurrentObject)
​
  if not CurrentObject.Iskindof(cls_NamedObject) then exit sub
​
  if CurrentObject.Iskindof(cls_Table) then 
​
   AddSheet CurrentObject.code
​
    ExportTable CurrentObject, sheet
​
    ExportCatalog CurrentObject
​
  else
​
    output "Found "+CurrentObject.ClassName+" """+CurrentObject.Name+""", Created by "+CurrentObject.Creator+" On "+Cstr(CurrentObject.CreationDate) 
​
  End if
​
End Sub
​
 
​
'----------------------------------------------------------------------------------------------
​
' 设置Excel的sheet页
​
'----------------------------------------------------------------------------------------------
​
Sub SetExcel()
​
  Set EXCEL= CreateObject("Excel.Application")
​
 
​
  ' 使Excel通过应用程序对象可见。
​
  EXCEL.Visible = True
​
  EXCEL.workbooks.add(-4167)'添加工作表
​
  EXCEL.workbooks(1).sheets(1).name ="pdm"
​
  set sheet = EXCEL.workbooks(1).sheets("pdm")
​
 
​
  ' 将一些文本放在工作表的第一行
​
  sheet.Cells(rowsNum, 1).Value = "表名"
​
  sheet.Cells(rowsNum, 2).Value = "表中文名"
​
  sheet.Cells(rowsNum, 3).Value = "表备注"
​
  sheet.Cells(rowsNum, 4).Value = "字段ID"
​
  sheet.Cells(rowsNum, 5).Value = "字段名"
​
  sheet.Cells(rowsNum, 6).Value = "字段中文名"
​
  sheet.Cells(rowsNum, 7).Value = "字段类型"
​
  sheet.Cells(rowsNum, 8).Value = "字段备注"
​
  sheet.cells(rowsNum, 9).Value = "主键"
​
  sheet.cells(rowsNum, 10).Value = "非空"
​
  sheet.cells(rowsNum, 11).Value = "默认值"
​
End Sub
​
 
​
'----------------------------------------------------------------------------------------------
​
' 导出目录结构
​
'----------------------------------------------------------------------------------------------
​
Sub ExportCatalog(tab)
​
  catalogNum = catalogNum + 1
​
  catalog.cells(catalogNum, 1).Value = tab.parent.name
​
  catalog.cells(catalogNum, 2).Value = tab.code
​
  catalog.cells(catalogNum, 3).Value = tab.comment
​
  '设置超链接
​
  catalog.Hyperlinks.Add catalog.cells(catalogNum,2), "",tab.code&"!A2"
​
End Sub 
​
 
​
'----------------------------------------------------------------------------------------------
​
' 导出sheet页
​
'----------------------------------------------------------------------------------------------
​
Sub ExportTable(tab, sheet)
​
  Dim col ' 运行列
​
  Dim colsNum
​
  colsNum = 0
​
  for each col in tab.columns
​
    colsNum = colsNum + 1
​
    rowsNum = rowsNum + 1
​
    sheet.Cells(rowsNum, 1).Value = tab.code
​
    'sheet.Cells(rowsNum, 2).Value = tab.name
​
    sheet.Cells(rowsNum, 2).Value = tab.comment
​
    'sheet.Cells(rowsNum, 4).Value = colsNum
​
    sheet.Cells(rowsNum, 3).Value = col.code
​
    'sheet.Cells(rowsNum, 4).Value = col.name
​
    sheet.Cells(rowsNum, 4).Value = col.datatype
​
     sheet.Cells(rowsNum, 5).Value = col.comment
​
    
​
    If col.Primary = true Then
​
      sheet.cells(rowsNum, 6) = "Y" 
​
    Else
​
      sheet.cells(rowsNum, 6) = "" 
​
    End If
​
    If col.Mandatory = true Then
​
      sheet.cells(rowsNum, 7) = "Y" 
​
    Else
​
      sheet.cells(rowsNum, 7) = "" 
​
    End If
​
    
​
    sheet.cells(rowsNum, 8).Value = col.defaultvalue
​
   '设置居中显示
​
   sheet.cells(rowsNum,6).HorizontalAlignment = 3
​
   sheet.cells(rowsNum,7).HorizontalAlignment = 3
​
  next
​
  output "Exported table: "+ +tab.Code+"("+tab.Name+")"
​
End Sub 
​
 
​
'----------------------------------------------------------------------------------------------
​
' 设置Excel目录页
​
'----------------------------------------------------------------------------------------------
​
Sub SetCatalog()
​
  Set EXCEL= CreateObject("Excel.Application")
​
  
​
  ' 使Excel通过应用程序对象可见。
​
  EXCEL.Visible = True
​
  EXCEL.workbooks.add(-4167)'添加工作表
​
  EXCEL.workbooks(1).sheets(1).name ="表结构"
​
  EXCEL.workbooks(1).sheets.add
​
  EXCEL.workbooks(1).sheets(1).name ="目录"
​
  set catalog = EXCEL.workbooks(1).sheets("目录")
​
 
​
  catalog.cells(catalogNum, 1) = "模块"
​
  catalog.cells(catalogNum, 2) = "表名"
​
  catalog.cells(catalogNum, 3) = "表注释"
​
  
​
  ' 设置列宽和自动换行
​
  catalog.Columns(1).ColumnWidth = 20
​
  catalog.Columns(2).ColumnWidth = 25
​
  catalog.Columns(3).ColumnWidth = 55
​
  
​
  '设置首行居中显示
​
  
​
  catalog.Range(catalog.cells(1,1),catalog.cells(1,3)).HorizontalAlignment = 3
​
  '设置首行字体加粗
​
  catalog.Range(catalog.cells(1,1),catalog.cells(1,3)).Font.Bold = True
​
End Sub 
​
 
​
'----------------------------------------------------------------------------------------------
​
' 新增sheet页
​
'----------------------------------------------------------------------------------------------
​
Sub AddSheet(sheetName)
​
  EXCEL.workbooks(1).Sheets(2).Select
​
  EXCEL.workbooks(1).sheets.add
​
  EXCEL.workbooks(1).sheets(2).name = sheetName
​
  set sheet = EXCEL.workbooks(1).sheets(sheetName)
​
  rowsNum = 1
​
  '将一些文本放在工作表的第一行
​
  sheet.Cells(rowsNum, 1).Value = "表名"
​
  'sheet.Cells(rowsNum, 2).Value = "表中文名"
​
  sheet.Cells(rowsNum, 2).Value = "表备注"
​
  'sheet.Cells(rowsNum, 4).Value = "字段ID"
​
  sheet.Cells(rowsNum, 3).Value = "字段名"
​
  'sheet.Cells(rowsNum, 4).Value = "字段中文名"
​
  sheet.Cells(rowsNum, 4).Value = "字段类型"
​
  sheet.Cells(rowsNum, 5).Value = "字段备注"
​
  sheet.cells(rowsNum, 6).Value = "主键"
​
  sheet.cells(rowsNum, 7).Value = "非空"
​
  sheet.cells(rowsNum, 8).Value = "默认值"
​
  
​
  '设置列宽
​
  sheet.Columns(1).ColumnWidth = 20
​
  sheet.Columns(2).ColumnWidth = 20
​
  sheet.Columns(3).ColumnWidth = 20
​
  sheet.Columns(4).ColumnWidth = 20
​
  sheet.Columns(5).ColumnWidth = 20
​
  sheet.Columns(6).ColumnWidth = 5
​
  sheet.Columns(7).ColumnWidth = 5
​
  sheet.Columns(8).ColumnWidth = 10
​
 
​
  '设置首行居中显示
​
  sheet.Range(sheet.cells(1,1),sheet.cells(1,8)).HorizontalAlignment = 3
​
  '设置首行字体加粗
​
  sheet.Range(sheet.cells(1,1),sheet.cells(1,8)).Font.Bold = True
​
  
​
  linkNum = linkNum + 1
​
  '设置超链接
​
  sheet.Hyperlinks.Add sheet.cells(1,1), "","目录"&"!B"&linkNum
​
End Sub 

导出结果如下图所示:

 

②如果有中文名称就会导出,注释也一并导出,表索引主键也会导出

Option Explicit
​
 
​
Dim mdl 
​
Set mdl = ActiveModel
​
If (mdl Is Nothing) Then
​
  MsgBox "There is no Active Model"
​
End If
​
Dim EXCEL, SheetList
​
Set EXCEL = CreateObject("Excel.Application") 
​
EXCEL.Visible = True 
​
EXCEL.Workbooks.Add
​
 
​
Dim tab 
​
Dim sheet 
​
For Each tab In mdl.tables
​
    EXCEL.workbooks(1).sheets.add
​
    EXCEL.workbooks(1).sheets(1).name = tab.code
​
    set sheet = EXCEL.workbooks(1).sheets(tab.code)
​
    EXCEL.visible = true
​
    sheet.Columns(1).ColumnWidth = 25
​
    sheet.Columns(2).ColumnWidth = 20
​
    sheet.Columns(3).ColumnWidth = 15
​
    sheet.Columns(4).ColumnWidth = 7
​
    sheet.Columns(5).ColumnWidth = 7
​
    sheet.Columns(6).ColumnWidth = 10
​
    sheet.Columns(7).ColumnWidth = 60
​
    sheet.Columns(1).WrapText =true
​
    sheet.Columns(2).WrapText =true
​
    sheet.Columns(4).WrapText =true
​
    EXCEL.ActiveWindow.DisplayGridlines = False
   
​
Next
​
  EXCEL.workbooks(1).sheets.add
​
  EXCEL.workbooks(1).sheets(1).name ="目录"
​
  set SheetList = EXCEL.workbooks(1).sheets("目录")
​
  ShowTableList mdl, SheetList
​
  CreateTab mdl, SheetList
​
 
​
 
​
Sub CreateTab(mdl, SheetList)
​
  Dim rowsNum, tablecode, tablname
​
  rowsNum = 0
​
  For Each tab In mdl.tables
​
    rowsNum = 1
​
    set SHEET = EXCEL.workbooks(1).sheets(tab.code)
​
      sheet.cells(rowsNum, 1) = "表中文名"
​
    tablecode = tab.code
​
    tablname = tab.name
​
    tablname = replace(tablname, tablecode, "")
​
    sheet.cells(rowsNum, 2) = tablname
​
    sheet.cells(rowsNum, 3) = "表英文名"
​
    sheet.cells(rowsNum, 4) = tab.code
​
    sheet.Range(sheet.cells(rowsNum, 4),sheet.cells(rowsNum, 6)).Merge
​
    sheet.cells(rowsNum, 7) = "返回目录"
​
    sheet.Hyperlinks.Add sheet.cells(rowsNum,7), "","目录"&"!B"&rowsNum
​
    rowsNum = rowsNum + 1
​
    sheet.cells(rowsNum, 1) = "表中文说明"
​
    sheet.cells(rowsNum, 2) = tab.name
​
    sheet.Range(sheet.cells(rowsNum, 2),sheet.cells(rowsNum, 7)).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.cells(rowsNum, 7) = "字段说明"
​
    addTabsCol sheet, tab, rowsNum
​
    addTabsidx sheet, tab, rowsNum
​
    addTabPK sheet, tab, rowsNum
​
    
​
    sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).Borders.LineStyle = "1"
​
    sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).Font.Size=10
​
    sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).Font.Name="微软雅黑"
​
    sheet.Range(sheet.cells(1, 1),sheet.cells(3, 7)).Interior.colorindex = "3"
​
    sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).RowHeight = "21"
​
    sheet.Range(sheet.cells(1, 1),sheet.cells(3, 7)).Font.Bold = True
​
    sheet.Range(sheet.cells(3, 7),sheet.cells(rowsNum, 7)) = " "
​
  Next
​
  
​
  
​
End Sub
​
 
​
Sub addTabsCol(sheet, tab, rowsNum)
​
  Dim col 
​
  Dim colsNum
​
  colsNum = 0
​
    for each col in tab.columns
​
      rowsNum = rowsNum + 1
​
      colsNum = colsNum + 1
​
        sheet.cells(rowsNum, 1) = col.code
​
       sheet.cells(rowsNum, 2) = col.name
​
        sheet.cells(rowsNum, 3) = col.datatype
​
      If col.Mandatory = true Then
​
        sheet.cells(rowsNum, 4) = "非空" 
​
      Else
​
        sheet.cells(rowsNum, 4) = " " 
​
      End If
​
        sheet.cells(rowsNum, 5) = col.DefaultValue
​
        sheet.cells(rowsNum, 7) = col.comment
​
    Next 
​
End Sub  
​
 
​
Sub addTabsidx(sheet, tab, rowsNum)
​
  rowsNum = rowsNum + 1
​
  sheet.cells(rowsNum, 1) = "索引名"
​
  sheet.cells(rowsNum, 2) = "索引类型"
​
  sheet.cells(rowsNum, 3) = "索引列表"
​
  sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Merge
​
  sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 7)).Font.Bold = True
​
  Dim index 
​
  Dim idxNm
​
  Dim indexstrlst 
​
  idxNm = 0
​
  for each index in tab.indexes
​
    rowsNum = rowsNum + 1
​
    idxNm = idxNm + 1
​
    sheet.cells(rowsNum, 1) = index.code
​
    if index.unique = "1" Then
​
      sheet.cells(rowsNum, 2) = "UNIQUE"
​
    Else
​
      sheet.cells(rowsNum, 2) = "NORM"
​
    End If
​
 
​
    Dim keystr
​
    Dim indexcol
​
    keystr = ""
​
    for each indexcol in index.IndexColumns
​
      keystr = keystr +","+ indexcol.code
​
    next
​
    keystr = mid(keystr, 2, len(keystr))
​
    sheet.cells(rowsNum, 3) = keystr
​
    sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Merge
​
   next
​
End Sub 
​
 
​
Sub addTabPK(sheet, tab, rowsNum)
​
  
​
  Dim key
​
  Dim keyNm
​
  Dim keystr
​
  Dim flag
​
  Dim keycode
​
  Dim keycol
​
  rowsNum = rowsNum + 1
​
  sheet.cells(rowsNum, 1) = "主键"
​
  sheet.cells(rowsNum, 2) = "索引类型"
​
  sheet.cells(rowsNum, 3) = "主键列表"
​
  sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Merge
​
  sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 7)).Font.Bold = True 
​
  for each key in tab.keys
​
    keycode = key.code
​
    if key.Primary = true Then
​
      flag = 1
​
      keystr = ""
​
      for each keycol in key.columns
​
        keystr = keystr +","+ keycol.code
​
      next
​
      keystr = mid(keystr, 2, len(keystr))
​
    End If
​
    next
​
    if flag = 1 Then
​
      rowsNum = rowsNum + 1
​
      keyNm = 1
​
      'sheet.cells(rowsNum, 1) = keycode
​
      sheet.cells(rowsNum, 1) = "PK_"+tab.code
​
      sheet.cells(rowsNum, 2) = "UNIQUE"
​
      sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Merge
​
      sheet.cells(rowsNum, 3) = keystr
​
    End If
​
End Sub 
​
 
​
Sub ShowTableList(mdl, SheetList)
​
  Dim rowsNum
​
  rowsNum=1
​
  SheetList.cells(rowsNum, 1) = "主题"
​
   SheetList.cells(rowsNum, 2) = "表中文名"
​
  SheetList.cells(rowsNum, 3) = "表英文名"
​
  SheetList.cells(rowsNum, 4) = "表说明"
​
  SheetList.Columns(1).ColumnWidth = 20 
​
  SheetList.Columns(2).ColumnWidth = 30 
​
  SheetList.Columns(3).ColumnWidth = 35 
​
  SheetList.Columns(4).ColumnWidth = 70 
​
  rowsNum = rowsNum + 1
​
  SheetList.cells(rowsNum, 1) = mdl.name
​
  
​
  Dim tab
​
  For Each tab In mdl.tables
​
    If IsObject(tab) Then
​
      rowsNum = rowsNum + 1
​
      SheetList.cells(rowsNum, 1) = ""
​
      SheetList.cells(rowsNum, 2) = replace(tab.name, tab.code, "")
​
      SheetList.cells(rowsNum, 3) = tab.code
​
      SheetList.cells(rowsNum, 4) = tab.comment
​
      sheetList.Hyperlinks.Add sheetList.cells(rowsNum,3), "",tab.code&"!B1"
​
      sheetList.Hyperlinks.Add sheetList.cells(rowsNum,2), "",tab.code&"!B1"
​
 
​
    End If
​
  Next
​
  SheetList.Range(SheetList.cells(1, 1),SheetList.cells(rowsNum, 4)).Borders.LineStyle = "1"
​
  SheetList.Range(SheetList.cells(1, 1),SheetList.cells(rowsNum, 4)).Font.Size=10
​
  SheetList.Range(SheetList.cells(1, 1),SheetList.cells(rowsNum, 4)).Font.Name="微软雅黑"
​
  SheetList.Range(SheetList.cells(1, 1),SheetList.cells(1, 4)).Interior.colorindex = "3"
​
  SheetList.Range(SheetList.cells(1, 1),SheetList.cells(rowsNum, 4)).RowHeight = "20"
​
  SheetList.Range(SheetList.cells(1, 1),SheetList.cells(1, 4)).Font.Bold = True
​
  SheetList.Range(SheetList.cells(2, 1),SheetList.cells(rowsNum, 3)).Font.Bold = True
​
  SheetList.Range(SheetList.cells(1, 5),SheetList.cells(rowsNum, 5)) = " "
​
  EXCEL.ActiveWindow.DisplayGridlines = False
​
 
​
End Sub

结果如下图所示:

 

相比较而言第二种方法比第一种更完美一点;