PDM文件转换生成excel文件

执行步骤:

1、菜单找到Tools

2、下拉中找到Execute Commands

3、选中Edit/Run Script

4、弹窗里黏贴上上面的代码

5、执行

场景一:

'******************************************************************************

'* Powerdesigner 导出Excel格式数据字典 导出Excel格式文件

'* Created:

'* Version: 1.0

'******************************************************************************

vbscript 复制代码
Option Explicit  
   Dim rowsNum  
   rowsNum = 2

Dim Model  
Set Model = ActiveModel  
If (Model Is Nothing) Or (Not Model.IsKindOf(PdPDM.cls_Model)) Then  
  Debug.print "null"
Else  
    ' Get the tables collection  
    '创建EXCEL APP  
    dim beginrow  
    DIM EXCEL, SHEET  
    set EXCEL = CREATEOBJECT("Excel.Application")  
    EXCEL.workbooks.add  '添加工作表  
    SET sheet = EXCEL.workbooks(1).sheets(1)  
    sheet.name ="数据字典"

   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) = "不可空"  
     sheet.cells(rowsNum, 8) = "默认值"  
     sheet.cells(rowsNum, 9) = "说明"  
     sheet.cells(rowsNum, 10) = "表名称"
     sheet.cells(rowsNum, 11) = "表中文名称"
     sheet.cells(rowsNum, 12) = "表说明"
     sheet.Range(sheet.cells(rowsNum,1),sheet.cells(rowsNum,12)).Interior.Color=rgb(166,166,166)      

   beginrow = rowsNum+1  

   Dim tab  
   For Each tab In Model.tables  
      TableLoop tab,SHEET  
   Next    

    EXCEL.visible = true  
    '设置列宽和自动换行  
    sheet.Columns(1).ColumnWidth  =10
    sheet.Columns(2).ColumnWidth  =15
    sheet.Columns(4).ColumnWidth  =20
    sheet.Columns(5).ColumnWidth  =15
    sheet.Columns(6).ColumnWidth  =15

    sheet.Columns("C:C").EntireColumn.AutoFit
    sheet.Columns("i:i").EntireColumn.AutoFit    
End If  

Sub TableLoop(tab, sheet)  
   If IsObject(tab) Then  
      Dim rangFlag  

      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.code
         sheet.cells(rowsNum, 3) = col.datatype
         sheet.cells(rowsNum, 4) = IIF(col.Length<>0,col.Length,"")
         sheet.cells(rowsNum, 5) = IIF(col.Primary,"√","")
         sheet.cells(rowsNum, 6) = IIF(col.Primary,"√","")
         sheet.cells(rowsNum, 7) = IIF(col.Mandatory,"√","")
         sheet.cells(rowsNum, 8) = "无"
         sheet.cells(rowsNum, 10) = tab.code
         sheet.cells(rowsNum, 11) = tab.name
         sheet.cells(rowsNum, 12) = tab.comment
      next  

      '设置边框  
      DIM RanagBorder
      SET RanagBorder =sheet.Range(sheet.cells(rowsNum-colsNum,1),sheet.cells(rowsNum,12))
      RanagBorder.Borders.LineStyle = "1"
      'RaneBorderFun RanagBorder        


   End If  
End Sub  

function IIF(flg,tstr,fstr)
   if flg then
      IIF= tstr
   else
      IIF= fstr
   end if
End function

场景二:

'******************************************************************************

'* Powerdesigner 导出Excel格式数据字典 导出Excel格式文件[分包存放]

'* Created: 根网科技

'* Version: 1.0

'******************************************************************************

vbscript 复制代码
Option Explicit  
   Dim rowsNum  
   rowsNum = 2

Dim Model
Dim  pkg
Set Model = ActiveModel
If (Model Is Nothing) Or (Not Model.IsKindOf(PdPDM.cls_Model)) Then  
  Debug.print "null"
else
      ' Get the tables collection  
    '创建EXCEL APP  
    dim beginrow  ,p
    DIM EXCEL, SHEET  
    set EXCEL = CREATEOBJECT("Excel.Application")  

    EXCEL.workbooks.add  '添加工作表
    For Each pkg In Model.packages  

        'MsgBox pkg.name         

        'MsgBox EXCEL.workbooks(1).Sheets.Count        
        SET sheet = EXCEL.workbooks(1).sheets(1)  
        sheet.name =pkg.name

        'MsgBox sheet.name
        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) = "不可空"  
         sheet.cells(rowsNum, 8) = "默认值"  
         sheet.cells(rowsNum, 9) = "说明"  
         sheet.cells(rowsNum, 10) = "表名称"
         sheet.cells(rowsNum, 11) = "表中文名称"
         sheet.cells(rowsNum, 12) = "表说明"
         sheet.Range(sheet.cells(rowsNum,1),sheet.cells(rowsNum,12)).Interior.Color=rgb(166,166,166)      

       beginrow = rowsNum+1  

       Dim tab  
       For Each tab In pkg.tables  
          TableLoop tab,SHEET  
          p=1
          'MsgBox sheet.name
       Next    
       EXCEL.workbooks(1).sheets.add  '添加工作表

    next
            EXCEL.visible = true  
        '设置列宽和自动换行  
        sheet.Columns(1).ColumnWidth  =10
        sheet.Columns(2).ColumnWidth  =15
        sheet.Columns(4).ColumnWidth  =20
        sheet.Columns(5).ColumnWidth  =15
        sheet.Columns(6).ColumnWidth  =15

        sheet.Columns("C:C").EntireColumn.AutoFit
        sheet.Columns("i:i").EntireColumn.AutoFit
end if
Sub TableLoop(tab, sheet)  
   If IsObject(tab) Then  
      Dim rangFlag  

      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.code
         sheet.cells(rowsNum, 3) = col.datatype
         sheet.cells(rowsNum, 4) = IIF(col.Length<>0,col.Length,"")
         sheet.cells(rowsNum, 5) = IIF(col.Primary,"√","")
         sheet.cells(rowsNum, 6) = IIF(col.Primary,"√","")
         sheet.cells(rowsNum, 7) = IIF(col.Mandatory,"√","")
         sheet.cells(rowsNum, 8) = "无"
         sheet.cells(rowsNum, 10) = tab.code
         sheet.cells(rowsNum, 11) = tab.name
         sheet.cells(rowsNum, 12) = tab.comment
      next  

      '设置边框  
      DIM RanagBorder
      SET RanagBorder =sheet.Range(sheet.cells(rowsNum-colsNum,1),sheet.cells(rowsNum,12))
      RanagBorder.Borders.LineStyle = "1"
      'RaneBorderFun RanagBorder        


   End If  
End Sub  

function IIF(flg,tstr,fstr)
   if flg then
      IIF= tstr
   else
      IIF= fstr
   end if
End function
相关推荐
孙同学_43 分钟前
【Linux篇】基础IO - 文件描述符的引入
linux·运维·网络
张彦峰ZYF2 小时前
高频面试题(含笔试高频算法整理)基本总结回顾63
linux·运维·算法
椰萝Yerosius4 小时前
Ubuntu Wayland启动腾讯会议并实现原生屏幕共享
linux·ubuntu·腾讯会议
爪娃侠5 小时前
LeetCode热题100记录-【二叉树】
linux·算法·leetcode
rufeike7 小时前
Rclone同步Linux数据到google云盘
linux·运维·服务器
csdn_aspnet7 小时前
如何在 Linux 上安装 Python
linux·运维·python
良许Linux8 小时前
怎么自学嵌入式?
linux
良许Linux8 小时前
你见过的最差的程序员是怎样的?
linux
良许Linux8 小时前
想从事嵌入式软件,有推荐的吗?
linux
bookish_2010_prj10 小时前
Jupyter notebook定制字体
linux·python·jupyter