Powerdesigner 導出Excel格式數據字典 導出Excel格式文件

  版權聲明：本文為博主原創文章，轉載請注明出處;

網上我也看到了很多的Powerdesigner 導出方法，因為Powerdesigner 提供了部分VBA功能，所以讓我用代碼導出Excel格式文件得以實現;

先看下效果圖：

1.首先這個是PowerDesign待導出的文件

2.執行腳本后導出的Excel截圖

3.后期規划導出效果圖（因為支持了VBA，所以都是可以實現的）：

 

一切以代碼為主，處理思路是，先讀取所有的Tables 循環遍歷，得到單表對象，然后就可以拿到相關屬性了，字段名，code，字段類型等，當然PowerDesign請按照官方格式填滿哦

看代碼哈

'******************************************************************************  
'* 我的淘寶店:   52sunan.taobao.com
'* 我的網站：    www.52sunan.com
'* Created:  
'* Version:  1.0  
'******************************************************************************  
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) ="淘寶服裝店地址：http://52sunan.taobao.com"
   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, 2),sheet.cells(rowsNum, 9)).Merge
      sheet.cells(rowsNum, 2)=tab.code
      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

http://www.52sunan.com 我平時搞的一個小網頁

執行方法：Tools -> Execute COmmands -> Edit/Run Script 或者用快捷鍵也可以：ctr+shift+X

里面有一個小問題，我還沒能獲取到字段的默認值屬性，用Default結果是關鍵字 使用不了，我正在研究中，向着最終文檔方向發展，希望大家多多支持與交流~

這里的技術主要是VBA，只要可以拿到VBA的地方就可以很容易操作Excel了，而Excel作為存檔文件的一個重要文件格式，平時偶爾會遇到整理數據字典，和其他公司聯協等，所以構建一些良好的文檔還是很必要的。

學好VBA,發現Excel 又變得繼續強大強大了。。。

 

以上涉及到的資料請見附件：附件PowerDesignToExcelFile