PowerDesigner导出数据表结构到Excel 一个表一个Sheet 带链接目录 (sheet是表名)

 

1. 先逆向导入你的sql
https://mp.csdn.net/console/editor/html/90756202

 2.选中需要导出的表,执行脚本


Option Explicit

   Dim rowsNum

   rowsNum = 0

'-----------------------------------------------------------------------------

' Main function

'-----------------------------------------------------------------------------

' Get the current active model

    Dim Model

    Set Model = ActiveModel

    If (Model Is Nothing) Or (Not Model.IsKindOf(PdPDM.cls_Model)) Then

       MsgBox "The current model is not an PDM model."

    Else

      ' Get the tables collection

      ' 创建EXCEL APP

      dim beginrow

      DIM EXCEL, BOOK, SHEETLIST

      set EXCEL = CREATEOBJECT("Excel.Application")

      set BOOK = EXCEL.workbooks.add(-4167) ' 创建工作簿

      BOOK.sheets(1).name ="目录"                     'Sheet名称

      set SHEETLIST = BOOK.sheets("目录")     'Sheet对象

            output "[line(21) info]: book.Sheet: " + BOOK.Sheets(1).Name

             

      BOOK.sheets.add               ' 添加工作表Sheet

            output "[line(24) info]: book.Sheet: " + BOOK.Sheets(1).Name

      'EXCEL.workbooks(1).sheets(1).name ="表结构"     'Sheet1名称

      'set SHEET = EXCEL.workbooks(1).sheets("表结构") 'Sheet1对象

        

      ShowTableList Model, SHEETLIST

              

      ShowProperties Model, BOOK

      
output  "[line(32) info]: Select: " + BOOK.Sheets(BOOK.Sheets.count).name  
           ' output  "[line(32) info]: Select: " + BOOK.Sheets(BOOK.Sheets.count).name           

      BOOK.Sheets(BOOK.Sheets.count).Select     '选择默认打开的工作表

      EXCEL.visible = true  ' 弹出Excel工作簿

      '不显示网格线

            'EXCEL.ActiveWindow.DisplayGridlines = True

 End If

              

'-----------------------------------------------------------------------------

' Show properties of tables

'-----------------------------------------------------------------------------

Sub ShowProperties(mdl, book)

   ' Show tables of the current model/package

   rowsNum=0

   beginrow = rowsNum+1

     output "[line(46) info]:   tables count : " &mdl.tables.count

      

   Dim rowIndex ' 为目录Sheet设置链接位置

   rowIndex=3

   output "[line(50) info]: 表结构 begin ========================"

   ' For each table

   Dim tab  ' Power Tables

   For Each tab In mdl.tables

      ShowTable mdl,tab,book,rowIndex

      rowIndex = rowIndex +1

   Next

    

   output "[line(58) info]: 表结构 end !Sheet totals is : " & book.Sheets.count

End Sub

 

'-----------------------------------------------------------------------------

' Show table properties

'-----------------------------------------------------------------------------

Sub ShowTable(mdl, tab, book,rowIndex)

  If IsObject(tab) Then

 

        rowsNum = 0

        rowsNum = rowsNum + 1   'rowsNum=1,工作表第一行

        Dim sheet
        book.sheets(1).name =  tab.name                     'Sheet名称

        set sheet = book.Sheets(1)
      

        ' Show properties

        Output "[line(72) info]:    " & book.Sheets.count &":" + sheet.name + ":" + tab.name 

        ' 设置列宽

    sheet.Columns(1).ColumnWidth = 20

    sheet.Columns(2).ColumnWidth = 20

    sheet.Columns(3).ColumnWidth = 20

    sheet.Columns(4).ColumnWidth = 40

    '根据需要添加列数,这里是4列,接着是自动换行

    sheet.Columns(1).WrapText =true

    sheet.Columns(2).WrapText =true

    sheet.Columns(4).WrapText =true

         

        Dim list

        set list = book.Sheets(book.Sheets.count)

        output "[line(85) info]:llist:为工作表"+ list.name +"工作表中的单元格设置超链接,对应1个表结构"

        list.Hyperlinks.Add list.cells(rowIndex,2), "", sheet.name &"!B"&rowsNum

         

        '字段名称    字段编码    数据类型    注释    

        sheet.cells(rowsNum, 1) = "字段名称"

        sheet.cells(rowsNum, 2) = "字段编码"

        sheet.cells(rowsNum, 3) = "数据类型"

        sheet.cells(rowsNum, 4) = "注释"

        '设置边框

        sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 4)).Borders.LineStyle = "1"

        '字体为10号

        sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 4)).Font.Size=10

         

        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) = col.comment

             

        next

         

        rowsNum = rowsNum + 1

        sheet.cells(rowsNum, 1) =tab.name

        sheet.cells(rowsNum, 1).HorizontalAlignment=3

        sheet.cells(rowsNum, 2) = tab.code

        'sheet.cells(rowsNum, 3) = tab.comment

        'sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 4)).Merge ' 单元格合并

 
         

        If book.Sheets.count-1 < mdl.tables.count Then book.Sheets.Add

         

  End If

     

End Sub

 

'-----------------------------------------------------------------------------

' Show List Of Table

'-----------------------------------------------------------------------------

Sub ShowTableList(mdl, SheetList)

   ' Show tables of the current model/package

   Dim rowsNo

   rowsNo=1

   output "[line(131) info]: 目录程序 begin"

   SheetList.cells(rowsNo, 1) = "主题"

   SheetList.cells(rowsNo, 2) = "表名称"

   SheetList.cells(rowsNo, 3) = "表编码"

   SheetList.cells(rowsNo, 4) = "表说明"

   rowsNo = rowsNo + 1

   SheetList.cells(rowsNo, 1) = mdl.name

   ' For each table

   Dim tab

   For Each tab In mdl.tables

     If IsObject(tab) Then

        rowsNo = rowsNo + 1

                SheetList.cells(rowsNo, 1) = ""

                SheetList.cells(rowsNo, 2) = tab.name

                SheetList.cells(rowsNo, 3) = tab.code

                SheetList.cells(rowsNo, 4) = tab.comment

     End If

   Next

    

    SheetList.Columns(1).ColumnWidth = 20

    SheetList.Columns(2).ColumnWidth = 20

    SheetList.Columns(3).ColumnWidth = 30

    SheetList.Columns(4).ColumnWidth = 60

End Sub
发布了151 篇原创文章 · 获赞 49 · 访问量 27万+

猜你喜欢

转载自blog.csdn.net/sunhuansheng/article/details/105576567