PowerDesigner 逆向生成excel文件（彩色版，带目录结构）

小董的数据库进阶之路

已于 2022-04-01 12:52:54 修改

阅读量195

点赞数

分类专栏： ETL 文章标签：数据库 etl oracle

于 2022-04-01 12:49:00 首次发布

本文链接：https://blog.csdn.net/u010438126/article/details/123894975

版权

ETL 专栏收录该内容

9 篇文章 2 订阅

订阅专栏

这段VBA代码用于从活动模型中提取数据，并生成Excel工作簿。它首先检查是否存在活动模型，然后创建Excel应用，添加工作簿并设置表格列宽。接着，对于模型中的每个表格，它会在新的Excel工作表中创建目录和详细信息，包括表的中文和英文名称、字段信息、索引和主键。此外，还创建了一个表单列出所有表格，方便用户导航。

摘要由CSDN通过智能技术生成

 
Option Explicit
 
Dim mdl 
Set mdl = ActiveModel
If (mdl Is Nothing) Then
   MsgBox "There is no Active Model"
End If
Dim EXCEL, SheetList
Set EXCEL = CreateObject("Excel.Application") 
EXCEL.Visible = True 
EXCEL.Workbooks.Add
 
Dim tab 
Dim sheet  
For Each tab In mdl.tables
        EXCEL.workbooks(1).sheets.add
        EXCEL.workbooks(1).sheets(1).name = tab.code
        set sheet = EXCEL.workbooks(1).sheets(tab.code)
        EXCEL.visible = true
        sheet.Columns(1).ColumnWidth = 25
        sheet.Columns(2).ColumnWidth = 20
        sheet.Columns(3).ColumnWidth = 15
        sheet.Columns(4).ColumnWidth = 7
        sheet.Columns(5).ColumnWidth = 7
        sheet.Columns(6).ColumnWidth = 10
        sheet.Columns(7).ColumnWidth = 60
        sheet.Columns(1).WrapText =true
        sheet.Columns(2).WrapText =true
        sheet.Columns(4).WrapText =true
        EXCEL.ActiveWindow.DisplayGridlines = False
        
Next
    EXCEL.workbooks(1).sheets.add
    EXCEL.workbooks(1).sheets(1).name ="目录"
    set SheetList = EXCEL.workbooks(1).sheets("目录")
    ShowTableList mdl, SheetList
    CreateTab mdl, SheetList
 
 
Sub CreateTab(mdl, SheetList)
    Dim rowsNum, tablecode, tablname
    rowsNum = 0
    For Each tab In mdl.tables
        rowsNum = 1
        set SHEET = EXCEL.workbooks(1).sheets(tab.code)
            sheet.cells(rowsNum, 1) = "表中文名"
        tablecode = tab.code
        tablname = tab.name
        tablname = replace(tablname, tablecode, "")
        sheet.cells(rowsNum, 2) = tablname
        sheet.cells(rowsNum, 3) = "表英文名"
        sheet.cells(rowsNum, 4) = tab.code
        sheet.Range(sheet.cells(rowsNum, 4),sheet.cells(rowsNum, 6)).Merge
        sheet.cells(rowsNum, 7) = "返回目录"
        sheet.Hyperlinks.Add sheet.cells(rowsNum,7), "","目录"&"!B"&rowsNum
        rowsNum = rowsNum + 1
        sheet.cells(rowsNum, 1) = "表中文说明"
        sheet.cells(rowsNum, 2) = tab.name
        sheet.Range(sheet.cells(rowsNum, 2),sheet.cells(rowsNum, 7)).Merge
        rowsNum = 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) = "字段说明"
        addTabsCol sheet, tab, rowsNum
        addTabsidx sheet, tab, rowsNum
        addTabPK sheet, tab, rowsNum
        
        sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).Borders.LineStyle = "1"
        sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).Font.Size=10
        sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).Font.Name="微软雅黑"
        sheet.Range(sheet.cells(1, 1),sheet.cells(3, 7)).Interior.colorindex = "3"
        sheet.Range(sheet.cells(1, 1),sheet.cells(rowsNum, 7)).RowHeight = "21"
        sheet.Range(sheet.cells(1, 1),sheet.cells(3, 7)).Font.Bold = True
        sheet.Range(sheet.cells(3, 7),sheet.cells(rowsNum, 7)) = " "
    Next
    
    
End Sub
 
Sub addTabsCol(sheet, tab, rowsNum)
    Dim col 
    Dim colsNum
    colsNum = 0
        for each col in tab.columns
            rowsNum = rowsNum + 1
            colsNum = colsNum + 1
                sheet.cells(rowsNum, 1) = col.code
                sheet.cells(rowsNum, 2) = col.name
                sheet.cells(rowsNum, 3) = col.datatype
            If col.Mandatory = true Then
                sheet.cells(rowsNum, 4) = "非空" 
            Else
                sheet.cells(rowsNum, 4) = " " 
            End If
                sheet.cells(rowsNum, 5) = col.DefaultValue
                sheet.cells(rowsNum, 7) =  col.comment
        Next 
End Sub    
 
Sub addTabsidx(sheet, tab, rowsNum)
    rowsNum = rowsNum + 1
    sheet.cells(rowsNum, 1) = "索引名"
    sheet.cells(rowsNum, 2) = "索引类型"
    sheet.cells(rowsNum, 3) = "索引列表"
    sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Merge
    sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 7)).Font.Bold = True
    Dim index 
    Dim idxNm
    Dim indexstrlst  
    idxNm = 0
    for each index in tab.indexes
        rowsNum = rowsNum + 1
        idxNm = idxNm + 1
        sheet.cells(rowsNum, 1) = index.code
        if index.unique = "1" Then
            sheet.cells(rowsNum, 2) = "UNIQUE"
        Else
            sheet.cells(rowsNum, 2) = "NORM"
        End If
 
        Dim keystr
        Dim indexcol
        keystr = ""
        for each indexcol in index.IndexColumns
            keystr = keystr +","+ indexcol.code
        next
        keystr = mid(keystr, 2, len(keystr))
        sheet.cells(rowsNum, 3) = keystr
        sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Merge
      next
End Sub 
 
Sub addTabPK(sheet, tab, rowsNum)
    
    Dim key
    Dim keyNm
    Dim keystr
    Dim flag
    Dim keycode
    Dim keycol
    rowsNum = rowsNum + 1
    sheet.cells(rowsNum, 1) = "主键"
    sheet.cells(rowsNum, 2) = "索引类型"
    sheet.cells(rowsNum, 3) = "主键列表"
    sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Merge
    sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 7)).Font.Bold = True 
    for each key in tab.keys
        keycode = key.code
        if key.Primary = true Then
            flag = 1
            keystr = ""
            for each keycol in key.columns
                keystr = keystr +","+ keycol.code
            next
            keystr = mid(keystr, 2, len(keystr))
        End If
        next
        if flag = 1 Then
            rowsNum = rowsNum + 1
            keyNm = 1
            'sheet.cells(rowsNum, 1) = keycode
            sheet.cells(rowsNum, 1) = "PK_"+tab.code
            sheet.cells(rowsNum, 2) = "UNIQUE"
            sheet.Range(sheet.cells(rowsNum, 3),sheet.cells(rowsNum, 7)).Merge
            sheet.cells(rowsNum, 3) = keystr
        End If
End Sub 
 
Sub ShowTableList(mdl, SheetList)
    Dim rowsNum
    rowsNum=1
    SheetList.cells(rowsNum, 1) = "主题"
    SheetList.cells(rowsNum, 2) = "表中文名"
    SheetList.cells(rowsNum, 3) = "表英文名"
    SheetList.cells(rowsNum, 4) = "表说明"
    SheetList.Columns(1).ColumnWidth = 20 
    SheetList.Columns(2).ColumnWidth = 30 
    SheetList.Columns(3).ColumnWidth = 35 
    SheetList.Columns(4).ColumnWidth = 70 
    rowsNum = rowsNum + 1
    SheetList.cells(rowsNum, 1) = mdl.name
    
    Dim tab
    For Each tab In mdl.tables
        If IsObject(tab) Then
            rowsNum = rowsNum + 1
            SheetList.cells(rowsNum, 1) = ""
            SheetList.cells(rowsNum, 2) = replace(tab.name, tab.code, "")
            SheetList.cells(rowsNum, 3) = tab.code
            SheetList.cells(rowsNum, 4) = tab.comment
            sheetList.Hyperlinks.Add sheetList.cells(rowsNum,3), "",tab.code&"!B1"
            sheetList.Hyperlinks.Add sheetList.cells(rowsNum,2), "",tab.code&"!B1"
 
        End If
    Next
    SheetList.Range(SheetList.cells(1, 1),SheetList.cells(rowsNum, 4)).Borders.LineStyle = "1"
    SheetList.Range(SheetList.cells(1, 1),SheetList.cells(rowsNum, 4)).Font.Size=10
    SheetList.Range(SheetList.cells(1, 1),SheetList.cells(rowsNum, 4)).Font.Name="微软雅黑"
    SheetList.Range(SheetList.cells(1, 1),SheetList.cells(1, 4)).Interior.colorindex = "3"
    SheetList.Range(SheetList.cells(1, 1),SheetList.cells(rowsNum, 4)).RowHeight = "20"
    SheetList.Range(SheetList.cells(1, 1),SheetList.cells(1, 4)).Font.Bold = True
    SheetList.Range(SheetList.cells(2, 1),SheetList.cells(rowsNum, 3)).Font.Bold = True
    SheetList.Range(SheetList.cells(1, 5),SheetList.cells(rowsNum, 5)) = " "
    EXCEL.ActiveWindow.DisplayGridlines = False
 
End Sub