Pb导出表结构到Excel

?'******************************************************************************
'* File: pdm2excel.txt
'* Title: pdm export to excel
'* Purpose: To export the tables and columns to Excel
'* Model: Physical Data Model
'* Objects: Table, Column, View
'* Author: By
'* Created: 2014-11-28
'* Version: 1.0
'******************************************************************************
Option Explicit
Dim rowsNum,fontName,fontSize,tableCount
rowsNum = 0
tableCount = 1
fontName = "微软雅黑"
fontSize = 10
'-----------------------------------------------------------------------------
' 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, SHEET,SHEET1
set EXCEL = CREATEOBJECT("Excel.Application")
EXCEL.workbooks.add(-4167)'添加工作表

set sheet1 = EXCEL.workbooks(1).Sheets(1) '添加新sheet
= "TABLE_ALL"
sheet1.Columns(1).ColumnWidth = 40
sheet1.Columns(2).ColumnWidth = 30
sheet1.Columns(3).ColumnWidth = 50

sheet1.cells(1,1) = "中文名称"
sheet1.cells(1,1) = fontName
sheet1.cells(1,1).Font.Size = fontSize
sheet1.cells(1,1).Font.Bold = true
sheet1.cells(1,1).WrapText = false

sheet1.cells(1,2) = "表名"
sheet1.cells(1,2) = fontName
sheet1.cells(1,2).Font.Size = fontSize
sheet1.cells(1,2).Font.Bold = true
sheet1.cells(1,3).WrapText = false

sheet1.cells(1,3) = "注释"
sheet1.cells(1,3) = fontName
sheet1.cells(1,3).Font.Size = fontSize
sheet1.cells(1,3).Font.Bold = true
sheet1.cells(1,3).WrapText = false

EXCEL.visible = true
ShowProperties Model



End If
'-----------------------------------------------------------------------------
' Show properties of tables
'-----------------------------------------------------------------------------
Sub ShowProperties(mdl)
' Show tables of the current model/package
rowsNum=0
beginrow = rowsNum+1
' For each table
output "begin"
Dim tab
For Each tab In mdl.tables
ShowTable tab
Next
if mdl.tables.count > 0 then
'sheet.Range("A" & beginrow + 1 & ":A" & rowsNum).Rows.Group
end if
output "end"
End Sub
'-----------------------------------------------------------------------------
' Show table properties
'-----------------------------------------------------------------------------
Sub ShowTable(tab)

If IsObject(tab) Then

'设置sheet1总表
tableCount = tableCount + 1

'sheet1.cells(tableCount,1) =
sheet1.Hyperlinks.Add sheet1.Range("A"&tableCount), "", tab.code&"!B1", "",
sheet1.cells(tableCount,1)

= fontName
sheet1.cells(tableCount,1).Font.Size = fontSize

sheet1.cells(tableCount,2) = tab.code
sheet1.cells(tableCount,2) = fontName
sheet1.cells(tableCount,2).Font.Size = fontSize

sheet1.cells(tableCount,3) = ment
sheet1.cells(tableCount,3) = fontName
sheet1.cells(tableCount,3).Font.Size = fontSize

set SHEET = EXCEL.workbooks(1).Sheets.Add
= tab.code

'设置列宽和自动换行
sheet.Columns(1).ColumnWidth = 20
sheet.Columns(2).ColumnWidth = 30
sheet.Columns(3).ColumnWidth = 30
sheet.Columns(4).ColumnWidth = 60
'sheet.Columns(1).WrapText =true
'sheet.Columns(2).WrapText =true
'sheet.Columns(4).WrapText =true


Dim rangFlag
rowsNum = 1
' Show properties
Output "================================"

sheet.cells(rowsNum, 1) =
sheet.cells(rowsNum, 1) = fontName
sheet.cells(rowsNum, 1).Font.Size = fontSize
'sheet.cells(rowsNum, 1).Font.Bold = true

sheet.cells(rowsNum, 2) = tab.code
sheet.cells(rowsNum, 2) = fontName
sheet.cells(rowsNum, 2).Font.Size = fontSize
'sheet.cells(rowsNum, 2).Font.Bold = true

sheet.cells(rowsNum, 3) = ment
sheet.cells(rowsNum, 3) = fontName
sheet.cells(rowsNum, 3).Font.Size = fontSize
'sheet.cells(rowsNum, 3).Font.Bold = true



rowsNum = rowsNum + 1

sheet.cells(rowsNum, 1) = "字段中文名"
sheet.cells(rowsNum, 1) = fontName
sheet.cells(rowsNum, 1).Font.Size = fontSize
sheet.cells(rowsNum, 1).Font.Bold = true
sheet.cells(rowsNum, 1).Interior.Color = RGB(217,217,217)

sheet.cells(rowsNum, 2) = "字段名"
sheet.cells(rowsNum, 2) = fontName
sheet.cells(rowsNum, 2).Font.Size = fontSize
sheet.cells(rowsNum, 2).Font.Bold = true
sheet.cells(rowsNum, 2).Interior.Color = RGB(217,217,217)

sheet.cells(rowsNum, 3) = "字段类型"
sheet.cells(rowsNum, 3) = fontName
sheet.cells(rowsNum, 3).Font.Size = fontSize
sheet.cells(rowsNum, 3).Font.Bold = true
sheet.cells(rowsNum, 3).Interior.Color = RGB(217,217,217)

sheet.cells(rowsNum, 4) = "注释"
sheet.cells(rowsNum, 4) = fontName
sheet.cells(rowsNum, 4).Font.Size = fontSize
sheet.cells(rowsNum, 4).Font.Bold = true
sheet.cells(rowsNum, 4).Interior.Color = RGB(217,217,217)



'设置边框
'sheet.Range(sheet.cells(rowsNum-1, 1),sheet.cells(rowsNum, 2)).Borders.LineStyle = "1"
'sheet.Range(sheet.cells(rowsNum-1, 4),sheet.cells(rowsNum, 6)).Borders.LineStyle = "1"
Dim col ' running column
Dim colsNum
colsNum = 0
for each col in tab.columns
rowsNum = rowsNum + 1
colsNu

m = colsNum + 1

sheet.cells(rowsNum, 1) =
sheet.cells(rowsNum, 1) = fontName
sheet.cells(rowsNum, 1).Font.Size = fontSize

sheet.cells(rowsNum, 2) = col.code
sheet.cells(rowsNum, 2) = fontName
sheet.cells(rowsNum, 2).Font.Size = fontSize

sheet.cells(rowsNum, 3) = col.datatype
sheet.cells(rowsNum, 3) = fontName
sheet.cells(rowsNum, 3).Font.Size = fontSize

sheet.cells(rowsNum, 4) = ment
sheet.cells(rowsNum, 4) = fontName
sheet.cells(rowsNum, 4).Font.Size = fontSize
next
'sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,2)).Borders.LineStyle = "2"
'sheet.Range(sheet.cells(rowsNum-colsNum+1,4),sheet.cells(rowsNum,6)).Borders.LineStyle = "2"
rowsNum = rowsNum + 1

Output "FullDescription: " +
End If
End Sub