PowerDesigner导出表到Excel，包含字段

PowerDesigner导出表到Excel，包含字段

使用方式：

打开需要导出的pdm,然后按快捷键：ctrl + shift +x

拷贝以下代码，点击Run(F5), 开始递归目录，稍等片刻就生成Excel

导出的excel样式：

PARA_ADMDVS_A	全国行政区划表	PARA_ADMDVS_A全国行政区划表	Administrator	2021/1/11
Code	Name	Comment	Datatype	Length	Primary	Mandatory
ADMDVS_CODG	行政区划代码	行政区划代码	VARCHAR(10)	10	TRUE	TRUE
ADMDVS_NAME	行政区划名称	行政区划名称	VARCHAR(100)	100	FALSE	FALSE
PRNT_ADMDVS_CODG	上级行政区划	上级行政区划	VARCHAR(10)	10	FALSE	FALSE
ADMDVS_CODG_PROV	所属省级区划代码	所属省级行政区划代码	VARCHAR(10)	10	FALSE	FALSE
ADMDVS_CODG_CITY	所属市级区划代码	所属市级行政区划代码	VARCHAR(10)	10	FALSE	FALSE
ADMDVS_LV	行政区划级别	行政区划级别（1省、2市、3县）	VARCHAR(1)	1	FALSE	FALSE

 

'******************************************************************************
'* File:     Export_model_to_excel.vbs
'* Purpose:  将PDM 的表导入Excel中 ，ctrl+shift+x 粘贴代码点击运行
'* Title:    
'* Category: 
'* Version:  1.0
'* Company:  Sybase Inc. 
'******************************************************************************
 
Option Explicit
 
 
Dim nb
Dim x1  
'
' get the current active model
'
Dim mdl ' the current model
Set mdl = ActiveModel
If (mdl Is Nothing) Then
   MsgBox "There is no Active Model"
End If
Dim fldr
Set Fldr = ActiveDiagram.Parent
nb =2
setExcel()
ListObjects(fldr)
x1.Columns("A:G").EntireColumn.AutoFit 'To adjust the column's width.
MsgBox "导出完成，请打开Excel查看"
 
Private Sub setExcel()
   ' Open & Create Excel Document
   Set x1 = CreateObject("Excel.Application") 
   x1.Visible = True 
   x1.Workbooks.Add  
End Sub
 
 
Private Sub ListObjects(fldr)
   Dim obj ' running object
   For Each obj In fldr.tables
      DescribeObject obj
   Next
End Sub
 
 
Sub DescribeObject(CurrentObject)
   if CurrentObject.ClassName ="Association-Class link" then exit sub
   output "Found "+CurrentObject.ClassName+" "+CurrentObject.Name+", Created by "+CurrentObject.Creator+" On "+FormatDateTime(CurrentObject.CreationDate,vbShortDate)   
   Dim startRow
   startRow = nb
   x1.Range("A"+Cstr(nb)).Value = CurrentObject.Code
   x1.Range("B"+Cstr(nb)).Value = CurrentObject.Comment 
   x1.Range("C"+Cstr(nb)).Value = CurrentObject.Name     
   x1.Range("D"+Cstr(nb)).Value = CurrentObject.Creator    
   x1.Range("E"+Cstr(nb)).Value = FormatDateTime(CurrentObject.CreationDate,vbShortDate) 
   x1.Range("A"+Cstr(nb)+":G"+Cstr(nb)).Interior.ColorIndex =34    
   nb = nb+1
   
   x1.Range("A"+Cstr(nb)).Value ="Code"
   x1.Range("B"+Cstr(nb)).Value ="Name"
   x1.Range("C"+Cstr(nb)).Value ="Comment"     
   x1.Range("D"+Cstr(nb)).Value ="Datatype"    
   x1.Range("E"+Cstr(nb)).Value ="Length" 
   x1.Range("F"+Cstr(nb)).Value ="Primary" 
   x1.Range("G"+Cstr(nb)).Value ="Mandatory" 
   x1.Range("A"+Cstr(startRow)+":G"+Cstr(nb)).font.Bold=true
   nb = nb+1
   Dim col ' running column
   for each col in CurrentObject.columns
         x1.Range("A"+Cstr(nb)).Value = col.Code
         x1.Range("B"+Cstr(nb)).Value = col.Name 
         x1.Range("C"+Cstr(nb)).Value = col.Comment     
         x1.Range("D"+Cstr(nb)).Value = col.Datatype    
         x1.Range("E"+Cstr(nb)).Value = col.Length 
         x1.Range("F"+Cstr(nb)).Value = col.Primary
         x1.Range("G"+Cstr(nb)).Value = col.Mandatory 
         nb = nb+1  
    next
    x1.Range("A"+Cstr(startRow)+":G"+Cstr(nb-1)).Borders.LineStyle = 1
    nb = nb+1  
End Sub