power designer 16.5 批量输出表格和视图到excel

'******************************************************************************
'* 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