【工具】powerdesigner生成excel文件（脚本）

汝之观览，吾之幸也！本文主要讲的是PowerDesigner工具如何导出excel文件、全局赋值comment字段注释

1、导出excel文件

'将powerdesigner 建好的表导出为excel文件
'1、使用Ctrl+Shift+X打开编辑页面
'2、复制以下代码
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 ="数据字典"  
   
   sheet.Range(sheet.cells(1, 1),sheet.cells(1, 9)).Merge
   sheet.cells(1, 1) ="标题"
   sheet.Range(sheet.cells(1, 1),sheet.cells(1, 9)).Interior.Color=rgb(146,208,80)
   
   rowsNum=2  
   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  
      rowsNum = rowsNum + 1  
      
      sheet.cells(rowsNum, 1) = "表名"  
      sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 9)).Merge
      sheet.cells(rowsNum, 2)=tab.code
	  sheet.cells(rowsNum, 3)=tab.name
      sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 9)).Borders.LineStyle = "1"
      sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 9)).Interior.Color=rgb(141,180,226)
      sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 9)).Borders.Weight ="3"
      
      rowsNum = rowsNum + 2
      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.Range(sheet.cells(rowsNum,1),sheet.cells(rowsNum,9)).Interior.Color=rgb(166,166,166)
      
      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, 9) = col.comment 
      next  

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

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

2、赋值comment字段为name的值

'把pd中那么name想自动添加到comment里面
'如果comment为空,则填入name;如果不为空,则保留不变,这样可以避免已有的注释丢失.
'1、使用Ctrl+Shift+X打开编辑页面
'2、复制以下代码
Option   Explicit    
ValidationMode   =   True    
InteractiveMode   =   im_Batch    
  
Dim   mdl   '   the   current   model    
  
'   get   the   current   active   model    
Set   mdl   =   ActiveModel    
If   (mdl   Is   Nothing)   Then    
      MsgBox   "There   is   no   current   Model "    
ElseIf   Not   mdl.IsKindOf(PdPDM.cls_Model)   Then    
      MsgBox   "The   current   model   is   not   an   Physical   Data   model. "    
Else    
      ProcessFolder   mdl    
End   If    
  
Private   sub   ProcessFolder(folder)    
On Error Resume Next   
      Dim   Tab   'running     table    
      for   each   Tab   in   folder.tables    
            if   not   tab.isShortcut   then    
                  tab.name   =   tab.comment   
                  Dim   col   '   running   column    
                  for   each   col   in   tab.columns    
                  if col.comment="" then   
                  else  
                        col.name=   col.comment    
                  end if  
                  next    
            end   if    
      next    
  
      Dim   view   'running   view    
      for   each   view   in   folder.Views    
            if   not   view.isShortcut   then    
                  view.name   =   view.comment    
            end   if    
      next    
  
      '   go   into   the   sub-packages    
      Dim   f   '   running   folder    
      For   Each   f   In   folder.Packages    
            if   not   f.IsShortcut   then    
                  ProcessFolder   f    
            end   if    
      Next    
end   sub

3、更改code、name、datatype字段大小写

# LCase 为小写，UCase 为大写
'1、使用Ctrl+Shift+X打开编辑页面
'2、复制以下代码
Option Explicit  
ValidationMode = True  
InteractiveMode = im_Batch  
Dim mdl ' 当前模型  
' 获取当前模型  
Set mdl = ActiveModel  
If (mdl Is Nothing) Then  
   MsgBox "没有打开一个模型" 
ElseIf Not mdl.IsKindOf(PdPDM.cls_Model) Then  
   MsgBox "当前模型不是一个PDM" 
Else  
'调用处理程序  
   ProcessFolder mdl  
End If    
'调用的处理程序  
Private sub ProcessFolder(folder)  
   Dim Tab '要处理的表  
   for each Tab in folder.Tables  
    ' if not Tab.isShortcut then  
        ' Tab.code = tab.name  
        '表名处理，前边添加前缀，字母小写  
        Tab.name=  LCase(Tab.name)  
        Tab.code= LCase(Tab.code)  
         Dim col ' 要处理的列  
         for each col in Tab.columns  
            '列名称和code全部小写，大写诗UCase  
            col.code= LCase(col.code)  
            col.name= LCase(col.name)  
            col.datatype= LCase(col.datatype)  
         next  
      'end if 
   next    
     'end if 
   end sub