PowerDesigner导出excel按表名排序

PowerDesigner导出excel按表名排序

一、导出到第一个sheet页，并按表名排序

'将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  
    Dim tableCount, maxTableNum, tableNames
    tableCount = Model.tables.count
    maxTableNum = tableCount - 1
    'MsgBox tableCount

    tableNames = SortTableList(Model, tableCount, maxTableNum)
    
    ' 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 i,tab
   For i=0 To maxTableNum
        tab=tableNames(1,i)
        TableLoop Model.tables.Item(tab),SHEET
        
   'Dim tab  
   'For Each tab In SortTables(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  

'-----------------------------------------------------------------------------
' Get Table List Sort By Name
'-----------------------------------------------------------------------------
Function SortTableList(mdl, count, maxNum)
    Dim tabs()
    ReDim tabs(2, count)
    Dim tab, i, j, temp

    'output "get table names"
    For i = 0 To maxNum
        temp = mdl.tables.Item(i).name
        tabs(0, i) = temp
        'output temp
    Next

    'output "sort table names ，if you want desc then update tabs(0,j)>tabs(0,i)"
    For i = 0 To maxNum
        For j = i + 1 To maxNum
            If tabs(0, j) < tabs(0, i) Then
                temp = tabs(0, i)
                tabs(0, i) = tabs(0, j)
                tabs(0, j) = temp
            End If
        Next
    Next

    'output "put table index to sorted names"
    i = 0
    For Each tab In Model.tables
        temp = tab.name
        'output tab.name
        For j = 0 To maxNum
            If (tabs(0, j)) = temp Then
                tabs(1, j) = i
            End If
        Next
        i = i + 1
    Next
    'For i = 0 To maxNum
    '    output tabs(0, i) + "-" & tabs(1, i)
    'Next
    SortTableList = tabs
End Function


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

参考：

https://blog.csdn.net/m0_37172770/article/details/126355278

https://blog.csdn.net/sidac/article/details/92803557