/**PageBeginHtml Block Begin **/ /***自定义返回顶部小火箭***/ /*生成博客目录的JS 开始*/ /*生成博客目录的JS 结束*/

powerDesigner导出Excel脚本

* 博客文章部分截图及内容来自于学习的书本及相应培训课程以及网络其他博客，仅做学习讨论之用，不做商业用途。
* 如有侵权，马上联系我，我立马删除对应链接。
* @author Alan
* @Email no008@foxmail.com

导出excel的脚本

如何将里面的表结构导出来到本地excel呢？

步骤：（1）打开powerDesigner，同时按住ctrl+shift+X，脚本框就会弹出来

同时按住ctrl+shift+X，脚本框就会弹出

 

（2）在脚本框中输入下面的代码（无需修改，直接复制粘贴就可），按下“Run”

 
 
分目录递归，查找当前PDM下所有表，并导出Excel，脚本代码如下：
 
复制代码
'******************************************************************************
'* File:     Exported_Excel_page.vbs
'* Purpose:  分目录递归，查找当前PDM下所有表，并导出Excel
'******************************************************************************

Option Explicit
ValidationMode = True
InteractiveMode = im_Batch

'-----------------------------------------------------------------------------
' 主函数
'-----------------------------------------------------------------------------
' 获取当前活动模型
Dim mdl ' 当前的模型
Set mdl = ActiveModel
Dim EXCEL,catalog,sheet,catalogNum,rowsNum,linkNum
rowsNum = 1
catalogNum = 1
linkNum = 1

If (mdl Is Nothing) Then
    MsgBox "There is no Active Model"
Else
    SetCatalog
    ListObjects(mdl)
End If

'----------------------------------------------------------------------------------------------
' 子过程，用于扫描当前包并从当前包中打印对象的信息，然后对当前包的所有子包再次调用相同的子过程
'----------------------------------------------------------------------------------------------
Private Sub ListObjects(fldr)
    output "Scanning " & fldr.code
    Dim obj ' 运行对象
    For Each obj In fldr.children
        ' 调用子过程来打印对象上的信息
        DescribeObject obj
    Next
    ' 进入子包
    Dim f ' 运行文件夹
    For Each f In fldr.Packages
        '调用子程序扫描子程序包
        ListObjects f
    Next
End Sub

'-----------------------------------------------------------------------------
' 子过程，用于在输出中打印当前对象的信息
'-----------------------------------------------------------------------------
Private Sub DescribeObject(CurrentObject)
    if not CurrentObject.Iskindof(cls_NamedObject) then exit sub
    if CurrentObject.Iskindof(cls_Table) then 
        AddSheet CurrentObject.code
        ExportTable CurrentObject, sheet
        ExportCatalog CurrentObject
    else
        output "Found "+CurrentObject.ClassName+" """+CurrentObject.Name+""", Created by "+CurrentObject.Creator+" On "+Cstr(CurrentObject.CreationDate)   
    End if
End Sub

'----------------------------------------------------------------------------------------------
' 设置Excel的sheet页
'----------------------------------------------------------------------------------------------
Sub SetExcel()
    Set EXCEL= CreateObject("Excel.Application")

    ' 使Excel通过应用程序对象可见。
    EXCEL.Visible = True
    EXCEL.workbooks.add(-4167)'添加工作表
    EXCEL.workbooks(1).sheets(1).name ="pdm"
    set sheet = EXCEL.workbooks(1).sheets("pdm")

    ' 将一些文本放在工作表的第一行
    sheet.Cells(rowsNum, 1).Value = "表名"
    sheet.Cells(rowsNum, 2).Value = "表中文名"
    sheet.Cells(rowsNum, 3).Value = "表备注"
    sheet.Cells(rowsNum, 4).Value = "字段ID"
    sheet.Cells(rowsNum, 5).Value = "字段名"
    sheet.Cells(rowsNum, 6).Value = "字段中文名"
    sheet.Cells(rowsNum, 7).Value = "字段类型"
    sheet.Cells(rowsNum, 8).Value = "字段备注"
    sheet.cells(rowsNum, 9).Value = "主键"
    sheet.cells(rowsNum, 10).Value = "非空"
    sheet.cells(rowsNum, 11).Value = "默认值"
End Sub

'----------------------------------------------------------------------------------------------
' 导出目录结构
'----------------------------------------------------------------------------------------------
Sub ExportCatalog(tab)
    catalogNum = catalogNum + 1
    catalog.cells(catalogNum, 1).Value = tab.parent.name
    catalog.cells(catalogNum, 2).Value = tab.code
    catalog.cells(catalogNum, 3).Value = tab.comment
    '设置超链接
    catalog.Hyperlinks.Add catalog.cells(catalogNum,2), "",tab.code&"!A2"
End Sub 

'----------------------------------------------------------------------------------------------
' 导出sheet页
'----------------------------------------------------------------------------------------------
Sub ExportTable(tab, sheet)
    Dim col ' 运行列
    Dim colsNum
    colsNum = 0
    for each col in tab.columns
        colsNum = colsNum + 1
        rowsNum = rowsNum + 1
        sheet.Cells(rowsNum, 1).Value = tab.code
        'sheet.Cells(rowsNum, 2).Value = tab.name
        sheet.Cells(rowsNum, 2).Value = tab.comment
        'sheet.Cells(rowsNum, 4).Value = colsNum
        sheet.Cells(rowsNum, 3).Value = col.code
        'sheet.Cells(rowsNum, 4).Value = col.name
        sheet.Cells(rowsNum, 4).Value = col.datatype
        sheet.Cells(rowsNum, 5).Value = col.comment
        
        If col.Primary = true Then
            sheet.cells(rowsNum, 6) = "Y" 
        Else
            sheet.cells(rowsNum, 6) = "" 
        End If
        If col.Mandatory = true Then
            sheet.cells(rowsNum, 7) = "Y" 
        Else
            sheet.cells(rowsNum, 7) = "" 
        End If
        
        sheet.cells(rowsNum, 8).Value = col.defaultvalue
        '设置居中显示
        sheet.cells(rowsNum,6).HorizontalAlignment = 3
        sheet.cells(rowsNum,7).HorizontalAlignment = 3
    next
    output "Exported table: "+ +tab.Code+"("+tab.Name+")"
End Sub 

'----------------------------------------------------------------------------------------------
' 设置Excel目录页
'----------------------------------------------------------------------------------------------
Sub SetCatalog()
    Set EXCEL= CreateObject("Excel.Application")
    
    ' 使Excel通过应用程序对象可见。
    EXCEL.Visible = True
    EXCEL.workbooks.add(-4167)'添加工作表
    EXCEL.workbooks(1).sheets(1).name ="表结构"
    EXCEL.workbooks(1).sheets.add
    EXCEL.workbooks(1).sheets(1).name ="目录"
    set catalog = EXCEL.workbooks(1).sheets("目录")

    catalog.cells(catalogNum, 1) = "模块"
    catalog.cells(catalogNum, 2) = "表名"
    catalog.cells(catalogNum, 3) = "表注释"
    
    ' 设置列宽和自动换行
    catalog.Columns(1).ColumnWidth = 20
    catalog.Columns(2).ColumnWidth = 25
    catalog.Columns(3).ColumnWidth = 55
    
    '设置首行居中显示
    
    catalog.Range(catalog.cells(1,1),catalog.cells(1,3)).HorizontalAlignment = 3
    '设置首行字体加粗
    catalog.Range(catalog.cells(1,1),catalog.cells(1,3)).Font.Bold = True
End Sub 

'----------------------------------------------------------------------------------------------
' 新增sheet页
'----------------------------------------------------------------------------------------------
Sub AddSheet(sheetName)
    EXCEL.workbooks(1).Sheets(2).Select
    EXCEL.workbooks(1).sheets.add
    EXCEL.workbooks(1).sheets(2).name = sheetName
    set sheet = EXCEL.workbooks(1).sheets(sheetName)
    rowsNum = 1
    '将一些文本放在工作表的第一行
    sheet.Cells(rowsNum, 1).Value = "表名"
    'sheet.Cells(rowsNum, 2).Value = "表中文名"
    sheet.Cells(rowsNum, 2).Value = "表备注"
    'sheet.Cells(rowsNum, 4).Value = "字段ID"
    sheet.Cells(rowsNum, 3).Value = "字段名"
    'sheet.Cells(rowsNum, 4).Value = "字段中文名"
    sheet.Cells(rowsNum, 4).Value = "字段类型"
    sheet.Cells(rowsNum, 5).Value = "字段备注"
    sheet.cells(rowsNum, 6).Value = "主键"
    sheet.cells(rowsNum, 7).Value = "非空"
    sheet.cells(rowsNum, 8).Value = "默认值"
    
    '设置列宽
    sheet.Columns(1).ColumnWidth = 20
    sheet.Columns(2).ColumnWidth = 20
    sheet.Columns(3).ColumnWidth = 20
    sheet.Columns(4).ColumnWidth = 20
    sheet.Columns(5).ColumnWidth = 20
    sheet.Columns(6).ColumnWidth = 5
    sheet.Columns(7).ColumnWidth = 5
    sheet.Columns(8).ColumnWidth = 10

    '设置首行居中显示
    sheet.Range(sheet.cells(1,1),sheet.cells(1,8)).HorizontalAlignment = 3
    '设置首行字体加粗
    sheet.Range(sheet.cells(1,1),sheet.cells(1,8)).Font.Bold = True
    
    linkNum = linkNum + 1
    '设置超链接
    sheet.Hyperlinks.Add sheet.cells(1,1), "","目录"&"!B"&linkNum
End Sub
复制代码

 

（3）就开始自动生成excel，并自动生成数据

动图封面
 

 

（4）导出excel结果如下：

 
posted @   一品堂.技术学习笔记  阅读(202)  评论(0)  编辑  收藏  举报
相关博文：
· Vue实现将table数据导出excel到本地
· Vue实现在线编辑excel、导入、导出(转)
· PowerDesigner导出Excel
· PowerDesigner 导出表结构为excel
· PowerDesigner从Excel导入表（批量）
阅读排行：
· 全程不用写代码，我用AI程序员写了一个飞机大战
· DeepSeek 开源周回顾「GitHub 热点速览」
· 记一次.NET内存居高不下排查解决与启示
· MongoDB 8.0这个新功能碉堡了，比商业数据库还牛
· .NET10 - 预览版1新功能体验（一）
点击右上角即可分享
微信分享提示

目录导航