PowerDesigner导出表到Excel

PowerDesigner导出表到Excel

使用方式：

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

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

导出的excel样式：

 

 

Code	Comment	Name	Table Creator	Creation Date
PARA_ALL_A	全局参数表	PARA_ALL_A全局参数表	Administrator	2021/1/11
PARA_ADMDVS_A	全国行政区划表	PARA_ADMDVS_A全国行政区划表	Administrator	2021/1/11

 

'******************************************************************************
'* 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:E").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
   x1.Range("A1").Value = "Code"
   x1.Range("B1").Value = "Comment"
   x1.Range("C1").Value = "Name"
   x1.Range("D1").Value = "Table Creator"
   x1.Range("E1").Value = "Creation Date"    
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)   
   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)    
   nb = nb+1
   
End Sub