'******************************************************************************
'* File: Pdm2Excel.vbs
'* Title: pdm export to excel
'* Purpose: To export the tables and views to Excel
'* model: Physical Data model
'* Objects: Table, View
'* Author: TangTao
'* Created: 2017-05-03
'* Version: 1.0
'******************************************************************************
Option Explicit
Dim rowIndex '记录表格行总数，也是行指针，全局变量
rowIndex = 0
' 引用power designer对象，以便遍历tab
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
DIM excel, sheet
set excel = CREATEOBJECT("Excel.Application")
excel.workbooks.add(-4167) '添加只包含一个sheet页的workbook
excel.workbooks(1).sheets(1).name ="tt" '设置sheet名
set sheet = excel.workbooks(1).sheets("tt") '获取该sheet页
printModel model, sheet '调用printmodel(mdl, sheet)方法
excel.visible = true
setExcelFormat sheet 'setExcelFormat(sheet)方法
End If
'-----------------------------------------------------------------------------
' 设置excel格式属性
'-----------------------------------------------------------------------------
Sub setExcelFormat(sheet)
'设置列宽和自动换行
sheet.Columns(1).ColumnWidth = 15 '列宽
sheet.Columns(2).ColumnWidth = 15
sheet.Columns(3).ColumnWidth = 15
sheet.Columns(4).ColumnWidth = 15
sheet.Columns(5).ColumnWidth = 15
sheet.Columns(6).ColumnWidth = 15
sheet.Columns(7).ColumnWidth = 15
'sheet.Columns(1).WrapText =true '自动换行
'sheet.Columns(3).WrapText =true
End Sub
'-----------------------------------------------------------------------------
' 打印表头
'-----------------------------------------------------------------------------
Sub printTabTitle(tab, sheet)
If IsObject(tab) Then
' 设置第1行表头
rowIndex = rowIndex + 1
sheet.cells(rowIndex, 1) = "表名"
sheet.cells(rowIndex, 2) = tab.name
' 合并(rowIndex,2)到(rowIndex,3)范围内单元格
sheet.Range(sheet.cells(rowIndex, 2),sheet.cells(rowIndex, 3)).Merge
' 合并(rowIndex,4)到(rowIndex,7)范围内单元格
sheet.cells(rowIndex, 4) = tab.code
sheet.Range(sheet.cells(rowIndex, 4),sheet.cells(rowIndex, 7)).Merge
' 设置第2行表头
rowIndex = rowIndex + 1
sheet.cells(rowIndex, 1) = "列名(name)"
sheet.cells(rowIndex, 2) = "列名(code)"
sheet.cells(rowIndex, 3) = "注释(comment)"
sheet.cells(rowIndex, 4) = "数据类型(data type)"
sheet.cells(rowIndex, 5) = "主键(primary key)"
sheet.cells(rowIndex, 6) = "外键(foreign key)"
sheet.cells(rowIndex, 7) = "非空(mandatory)"
' 设置边框
sheet.Range(sheet.cells(rowIndex - 1, 1),sheet.cells(rowIndex, 7)).Borders.LineStyle = "1"
' 设置单元格颜色
sheet.Range(sheet.cells(rowIndex - 1, 1),sheet.cells(rowIndex - 1, 7)).Interior.colorindex = 15
End If
End Sub
'-----------------------------------------------------------------------------
' 打印模型
'-----------------------------------------------------------------------------
Sub printModel(mdl, sheet)
' 通过mdl遍历所有表格
Dim tab
For Each tab In mdl.tables
printTable tab,sheet ' 调用printTable(tab,sheet)函数
Next
' 通过mdl遍历所有视图
Dim view
For Each view In mdl.views
printView view,sheet ' 调用printView(view,sheet)函数
Next
End Sub
'-----------------------------------------------------------------------------
' 打印表格
'-----------------------------------------------------------------------------
Sub printTable(tab, sheet)
' 与上一表格留出两行空行
rowIndex = rowIndex + 2
If IsObject(tab) Then
' 设置表头，rowIndex+2
printTabTitle tab, sheet ' 调用printTabTitle(tab,sheet)函数
' 循环遍历每列，输出信息
Dim col
Dim colNum
colNum = 0
for each col in tab.columns
printCol col, sheet ' 调用printCol(col,sheet)函数
colNum = colNum + 1
next
' 设置列边框
sheet.Range(sheet.cells(rowIndex - colNum + 1, 1), sheet.cells(rowIndex, 7)).Borders.LineStyle = "1"
End If
End Sub
'-----------------------------------------------------------------------------
' 打印列
'-----------------------------------------------------------------------------
Sub printCol(col, sheet)
'Stop
rowIndex = rowIndex + 1
sheet.cells(rowIndex, 1) = col.name
sheet.cells(rowIndex, 2) = col.code
sheet.cells(rowIndex, 3) = col.comment
sheet.cells(rowIndex, 4) = col.datatype
' 设置主键、外键、非空标志
If col.Primary Then
sheet.cells(rowIndex, 5) = "P"
sheet.cells(rowIndex, 5).VerticalAlignment = 2 ' 垂直居中
sheet.cells(rowIndex, 5).HorizontalAlignment = 3 ' 水平居中
Else
sheet.cells(rowIndex, 5) = ""
End If
If col.ForeignKey Then
sheet.cells(rowIndex, 6) = "F"
sheet.cells(rowIndex, 6).VerticalAlignment = 2 ' 垂直居中
sheet.cells(rowIndex, 6).HorizontalAlignment = 3 ' 水平居中
Else
sheet.cells(rowIndex, 6) = ""
End If
If col.Mandatory Then
sheet.cells(rowIndex, 7) = "M"
sheet.cells(rowIndex, 7).VerticalAlignment = 2 ' 垂直居中
sheet.cells(rowIndex, 7).HorizontalAlignment = 3 ' 水平居中
Else
sheet.cells(rowIndex, 7) = ""
End If
' 如果是power designer中的复制列，将改行字体修改为灰色
If col.Replica Then
sheet.Range(sheet.cells(rowIndex, 1), sheet.cells(rowIndex, 7)).Font.Color = RGB(150, 150, 150)
End If
End Sub
'-----------------------------------------------------------------------------
' 打印视图抬头
'-----------------------------------------------------------------------------
Sub printViewTitle(view, sheet)
If IsObject(view) Then
' 设置第1行表头
rowIndex = rowIndex + 1
sheet.cells(rowIndex, 1) = "视图名"
sheet.cells(rowIndex, 2) = view.name
' 合并(rowIndex,3)到(rowIndex,4)范围内单元格
sheet.cells(rowIndex, 3) = view.code
sheet.Range(sheet.cells(rowIndex, 3),sheet.cells(rowIndex, 4)).Merge
' 设置第2行表头
rowIndex = rowIndex + 1
sheet.cells(rowIndex, 1) = "列名(name)"
sheet.cells(rowIndex, 2) = "列名(code)"
sheet.cells(rowIndex, 3) = "注释(comment)"
sheet.cells(rowIndex, 4) = "数据类型(data type)"
' 设置边框
sheet.Range(sheet.cells(rowIndex - 1, 1),sheet.cells(rowIndex, 4)).Borders.LineStyle = "1"
' 设置单元格颜色
sheet.Range(sheet.cells(rowIndex - 1, 1),sheet.cells(rowIndex - 1, 4)).Interior.colorindex = 34
End If
End Sub
'-----------------------------------------------------------------------------
' 打印视图
'-----------------------------------------------------------------------------
Sub printView(view, sheet)
' 与上一表格留出两行空行
rowIndex = rowIndex + 2
If IsObject(view) Then
' 设置表头，rowIndex+2
printViewTitle view, sheet ' 调用printViewTitle(view,sheet)函数
' 循环遍历每列，输出信息
Dim col
Dim colNum
colNum = 0
for each col in view.columns
rowIndex = rowIndex + 1
sheet.cells(rowIndex, 1) = col.name
sheet.cells(rowIndex, 2) = col.code
sheet.cells(rowIndex, 3) = col.comment
sheet.cells(rowIndex, 4) = col.datatype
colNum = colNum + 1
next
' 设置列边框
sheet.Range(sheet.cells(rowIndex - colNum + 1, 1), sheet.cells(rowIndex, 4)).Borders.LineStyle = "1"
End If
End Sub
参考vbs设置excel格式链接:
http://blog.csdn.net/llbacyal/article/details/9208545/
http://mimmy.iteye.com/blog/1622365vbs excel color index
vbs excel color index
