PowerDesigner导出所有表到Excel（同一表格）

╰+攻爆jí腚メ 2023-10-05 08:33 2阅读 0赞

打开pdm,然后按快捷键：ctrl + shift +x

输入以下脚本，点击Run

将会按照 以下形式生成Excel：

<table style="width:479.27pt;"> 
 <tbody> 
  <tr> 
   <td style="vertical-align:middle;width:101.25pt;"><span style="color:#000000;">表名</span></td> 
   <td style="vertical-align:middle;width:54pt;"><span style="color:#000000;">表中文名</span></td> 
   <td style="vertical-align:middle;width:54pt;"><span style="color:#000000;">表备注</span></td> 
   <td style="vertical-align:middle;width:54pt;"><span style="color:#000000;">字段ID</span></td> 
   <td style="vertical-align:middle;width:54pt;"><span style="color:#000000;">字段名</span></td> 
   <td style="vertical-align:middle;width:54pt;"><span style="color:#000000;">字段中文名</span></td> 
   <td style="vertical-align:middle;width:54pt;"><span style="color:#000000;">字段类型</span></td> 
   <td style="vertical-align:middle;width:54pt;"><span style="color:#000000;">字段备注</span></td> 
  </tr> 
 </tbody> 
</table>

'******************************************************************************
    '* File:     pdm2excel.vbs
    '* Purpose:  分目录递归，查找当前PDM下所有表，并导出Excel
    '* Title:    
    '* Category: 
    '* Version:  1.0
    '* Author:  huhaicool@sina.com
    '******************************************************************************
    Option Explicit
    ValidationMode = True
    InteractiveMode = im_Batch
    ' get the current active model
    Dim mdl ' the current model
    Set mdl = ActiveModel
    Dim EXCEL,sheet,rowsNum
    rowsNum = 1
    
    If (mdl Is Nothing) Then
        MsgBox "There is no Active Model"
    Else
        SetExcel
        ListObjects(mdl)
    End If
    '-----------------------------------------------------------------------------
    ' Sub procedure to scan current package and print information on objects from current package
    ' and call again the same sub procedure on all children pacakge 
    ' of the current package
    '-----------------------------------------------------------------------------
    Private Sub ListObjects(fldr)
        output "Scanning " & fldr.code
        Dim obj ' running object
        For Each obj In fldr.children
            ' Calling sub procedure to print out information on the object
            DescribeObject obj
        Next
        ' go into the sub-packages
        Dim f ' running folder
        For Each f In fldr.Packages
            'calling sub procedure to scan children package
            ListObjects f
        Next
    End Sub
    '-----------------------------------------------------------------------------
    ' Sub procedure to print information on current object in output
    '-----------------------------------------------------------------------------
    Private Sub DescribeObject(CurrentObject)
        if not CurrentObject.Iskindof(cls_NamedObject) then exit sub
        if CurrentObject.Iskindof(cls_Table) then 
            ExportTable CurrentObject, sheet
        else
            output "Found "+CurrentObject.ClassName+" """+CurrentObject.Name+""", Created by "+CurrentObject.Creator+" On "+Cstr(CurrentObject.CreationDate)   
        End if
    End Sub
    
    
    Sub SetExcel()
        Set EXCEL= CreateObject("Excel.Application")
    
        ' Make Excel visible through the Application object.
        EXCEL.Visible = True
        EXCEL.workbooks.add(-4167)'添加工作表
        EXCEL.workbooks(1).sheets(1).name ="pdm"
        set sheet = EXCEL.workbooks(1).sheets("pdm")
    
        ' Place some text in the first Row of the sheet.
        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 = "字段备注"
    End Sub
    
    Sub ExportTable(tab, sheet)
        Dim col ' running column
        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, 3).Value = tab.comment
            sheet.Cells(rowsNum, 4).Value = colsNum
            sheet.Cells(rowsNum, 5).Value = col.code
            sheet.Cells(rowsNum, 6).Value = col.name
            sheet.Cells(rowsNum, 7).Value = col.datatype
            sheet.Cells(rowsNum, 8).Value = col.comment
        next
        output "Exported table: "+ +tab.Code+"("+tab.Name+")"
    End Sub