PowerDesign导出Excel - 《Java 专栏》

转：https://blog.csdn.net/u012933239/article/details/108646628

Option Explicit
ValidationMode = True
InteractiveMode = im_Batch

‘——————————————————
‘ 主函数
‘——————————————————
Dim mdl
Set mdl = ActiveModel
Dim EXCEL
Dim sheet,rowsNum ‘目录表
Dim SHEETLIST,catalogNum ‘中心表
Dim sheetname ‘当前工作簿名称
rowsNum = 1
catalogNum = 1

If (mdl Is Nothing) Then
MsgBox “There is no Active Model”
Else
SetExcel
ListObjects(mdl)
End If
‘——————————————————————————————————————-
‘ 扫描当前包并从当前包打印有关对象的信息的子过程
‘ 并对所有的孩子pacakge再次调用相同的子过程
‘——————————————————————————————————————-
Private Sub ListObjects(fldr)
output “Scanning “ & fldr.code

‘创建分中心工作簿
SetExcelCenter fldr

Dim f
For Each f In fldr.Packages
ListObjects f
Next
End Sub
‘——————————————————————————————————————-
‘ 遍历分中心表
‘——————————————————————————————————————-
Private Sub DescribeObject(CurrentObject, SHEETLIST, sheetname)
output “遍历表：” & CurrentObject.code
if not CurrentObject.Iskindof(cls_NamedObject) then exit sub
if CurrentObject.Iskindof(cls_Table) then
ExportTable CurrentObject, SHEETLIST, sheetname
else
output “Found “+CurrentObject.ClassName+” “””+CurrentObject.Name+”””, Created by “+CurrentObject.Creator+” On “+Cstr(CurrentObject.CreationDate)
End if
End Sub
‘——————————————————————————————————————-
‘ 创建目录工作簿
‘——————————————————————————————————————-
Sub SetExcel()
set EXCEL = CREATEOBJECT(“Excel.Application”)
EXCEL.Visible = True
EXCEL.workbooks.add(-4167)
EXCEL.workbooks(1).sheets(1).name = “目录”
set sheet = EXCEL.workbooks(1).sheets(“目录”)

  '目录页设置<br />      '头部样式设置<br />      sheet.cells(rowsNum, 1).Value = "表文件夹名称"<br />      sheet.cells(rowsNum, 2).Value = "表名"<br />      sheet.cells(rowsNum, 3).Value = "表中文名"<br />      sheet.cells(rowsNum, 4).Value = "表备注"<br />      sheet.Columns(1).ColumnWidth = 20<br />      sheet.Columns(2).ColumnWidth = 30<br />      sheet.Columns(3).ColumnWidth = 30<br />      sheet.Columns(4).ColumnWidth = 30<br />      sheet.Columns(1).WrapText =true<br />      sheet.Columns(2).WrapText =true<br />      sheet.Columns(3).WrapText =true<br />      sheet.Columns(4).WrapText =true<br />      '设置边框<br />      sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 4)).Borders.LineStyle = "1"<br />      '字体为15号<br />      sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 4)).Font.Size=15<br />      '字体加粗<br />      sheet.Range(sheet.cells(rowsNum, 1),sheet.cells(rowsNum, 4)).Font.Bold = True<br />      '不显示网格线<br />      EXCEL.ActiveWindow.DisplayGridlines = False
  output "创建成功工作簿‘目录’"<br />

End Sub

‘——————————————————————————————————————-
‘ 创建分中心工作簿
‘——————————————————————————————————————-
Sub SetExcelCenter(fldr)

EXCEL.workbooks(1).sheets.add
EXCEL.workbooks(1).sheets(1).name =fldr.name
set SHEETLIST = EXCEL.workbooks(1).sheets(fldr.name)
rowsNum = 1
‘分中心设置
‘头部样式设置
SHEETLIST.Columns(1).ColumnWidth = 20
SHEETLIST.Columns(2).ColumnWidth = 30
SHEETLIST.Columns(3).ColumnWidth = 30
SHEETLIST.Columns(4).ColumnWidth = 20
SHEETLIST.Columns(5).ColumnWidth = 20
SHEETLIST.Columns(6).ColumnWidth = 20
SHEETLIST.Columns(7).ColumnWidth = 20
SHEETLIST.Columns(1).WrapText =true
SHEETLIST.Columns(2).WrapText =true
SHEETLIST.Columns(3).WrapText =true
SHEETLIST.Columns(4).WrapText =true
SHEETLIST.Columns(5).WrapText =true
SHEETLIST.Columns(6).WrapText =true
SHEETLIST.Columns(7).WrapText =true
‘不显示网格线
EXCEL.ActiveWindow.DisplayGridlines = False

  output "创建成功工作簿" & fldr.name<br />      sheetname = fldr.name<br />      <br />      '遍历分中心包<br />      Dim obj <br />        For Each obj In fldr.children<br />        DescribeObject obj,SHEETLIST,sheetname<br />      Next<br />End Sub

‘——————————————————————————————————————-
‘ 将表结构遍历至“分中心”工作簿中
‘——————————————————————————————————————-
Sub ExportTable(tab, SHEETLIST, sheetname)
‘将表名记录至“目录”工作簿中
ExportCatalog tab, sheetname
Dim col

'头部样式设置<br />    SHEETLIST.cells(rowsNum, 1).Value = "表中文名"<br />    SHEETLIST.cells(rowsNum, 2).Value = "表名"<br />    SHEETLIST.cells(rowsNum, 3).Value = "表备注"<br />    <br />    '设置边框<br />    SHEETLIST.Range(SHEETLIST.cells(rowsNum, 1),SHEETLIST.cells(rowsNum, 3)).Borders.LineStyle = "1"<br />    '字体为15号<br />    SHEETLIST.Range(SHEETLIST.cells(rowsNum, 1),SHEETLIST.cells(rowsNum, 3)).Font.Size=15<br />    '字体加粗<br />    SHEETLIST.Range(SHEETLIST.cells(rowsNum, 1),SHEETLIST.cells(rowsNum, 3)).Font.Bold = True
rowsNum = rowsNum + 1<br />    SHEETLIST.cells(rowsNum, 1).Value =tab.name<br />    'SHEETLIST.cells(rowsNum, 1).HorizontalAlignment=3<br />    SHEETLIST.cells(rowsNum, 2).Value = tab.code<br />    SHEETLIST.cells(rowsNum, 3).Value = tab.comment<br />    'SHEETLIST.Range(SHEETLIST.cells(rowsNum, 3),SHEETLIST.cells(rowsNum, 7)).Merge<br />    '设置边框<br />    SHEETLIST.Range(SHEETLIST.cells(rowsNum, 1),SHEETLIST.cells(rowsNum, 3)).Borders.LineStyle = "1"<br />    '字体为10号<br />    SHEETLIST.Range(SHEETLIST.cells(rowsNum, 1),SHEETLIST.cells(rowsNum, 3)).Font.Size=10<br />   <br />    'sheet.Hyperlinks.Add sheet.cells(catalogNum,2), "","表结构"&"!B"&rowsNum
'表头设置<br />    rowsNum = rowsNum + 1<br />    SHEETLIST.cells(rowsNum, 1).Value = "字段中文名"<br />    SHEETLIST.cells(rowsNum, 2).Value = "字段英文名"<br />    SHEETLIST.cells(rowsNum, 3).Value = "字段类型"<br />    SHEETLIST.cells(rowsNum, 4).Value = "注释"<br />    SHEETLIST.cells(rowsNum, 5).Value = "是否主键"<br />    SHEETLIST.cells(rowsNum, 6).Value = "是否非空"<br />    SHEETLIST.cells(rowsNum, 7).Value = "默认值"<br />    '设置边框<br />    SHEETLIST.Range(SHEETLIST.cells(rowsNum, 1),SHEETLIST.cells(rowsNum, 7)).Borders.LineStyle = "1"<br />    '字体为15号<br />    SHEETLIST.Range(SHEETLIST.cells(rowsNum, 1),SHEETLIST.cells(rowsNum, 7)).Font.Size=15<br />    '字体加粗<br />    SHEETLIST.Range(SHEETLIST.cells(rowsNum, 1),SHEETLIST.cells(rowsNum, 7)).Font.Bold = True<br />    rowsNum = rowsNum + 1<br />    for each col in tab.columns
    '设置边框<br />        SHEETLIST.Range(SHEETLIST.cells(rowsNum, 1),SHEETLIST.cells(rowsNum, 7)).Borders.LineStyle = "1"<br />        '字体为10号<br />        SHEETLIST.Range(SHEETLIST.cells(rowsNum, 1),SHEETLIST.cells(rowsNum, 7)).Font.Size=10
    SHEETLIST.Cells(rowsNum, 1).Value = col.name<br />        SHEETLIST.Cells(rowsNum, 2).Value = col.code<br />        SHEETLIST.Cells(rowsNum, 3).Value = col.datatype<br />        SHEETLIST.Cells(rowsNum, 4).Value = col.comment
    If col.Primary = true Then<br />            SHEETLIST.cells(rowsNum, 5).Value = "Y"<br />        Else<br />            SHEETLIST.cells(rowsNum, 5).Value = " "<br />        End If
    If col.Mandatory = true Then<br />            SHEETLIST.cells(rowsNum, 6).Value = "Y"<br />        Else<br />            SHEETLIST.cells(rowsNum, 6).Value = " "<br />        End If
    SHEETLIST.cells(rowsNum, 7).Value =  col.defaultvalue<br />        rowsNum = rowsNum + 1<br />    next<br />    rowsNum = rowsNum + 2<br />    output "Exported table: "+ +tab.Code+"("+tab.Name+")"<br />End Sub

‘——————————————————————————————————————-
‘ 将表名记录至“目录”工作簿中
‘——————————————————————————————————————-
Sub ExportCatalog(tab, sheetname)
catalogNum = catalogNum + 1
sheet.cells(catalogNum, 1).Value = tab.parent.name
sheet.cells(catalogNum, 2).Value = tab.code
sheet.cells(catalogNum, 3).Value = tab.name
sheet.cells(catalogNum, 4).Value = tab.comment
‘设置超链接
sheet.Hyperlinks.Add sheet.cells(catalogNum,2), “”,sheetname&”!A”&rowsNum+1
output “设置表连接：table: “+tab.Code+ “链接详情：”+sheetname&”!A”&rowsNum+1

'设置边框<br />    sheet.Range(sheet.cells(catalogNum, 1),sheet.cells(catalogNum, 4)).Borders.LineStyle = "1"<br />    '字体为10号<br />    sheet.Range(sheet.cells(catalogNum, 1),sheet.cells(catalogNum, 4)).Font.Size=10<br />End Sub