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