- '******************************************************************************
- Option Explicit
- Dim rowsNum
- rowsNum =0
- '-----------------------------------------------------------------------------
- ' Main function
- '-----------------------------------------------------------------------------
- ' Get the current active model
- Dim Model
- SetModel = ActiveModel
- If(ModelIs Nothing)Or(NotModel.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, SHEETLIST
- setEXCEL =CREATEOBJECT("Excel.Application")
- EXCEL.workbooks.add(-4167)'添加工作表EXCEL.workbooks(1).sheets(1).name ="表结构"
- setSHEET = EXCEL.workbooks(1).sheets("表结构")
- EXCEL.workbooks(1).sheets.add
- EXCEL.workbooks(1).sheets(1).name ="目录"
- setSHEETLIST = EXCEL.workbooks(1).sheets("目录")
- ShowTableList Model,SHEETLIST
- ShowProperties Model, SHEET,SHEETLIST
- EXCEL.workbooks(1).Sheets(2).Select
- EXCEL.visible =true
- '设置列宽和自动换行sheet.Columns(1).ColumnWidth =20
- sheet.Columns(2).ColumnWidth =20
- sheet.Columns(3).ColumnWidth =20
- sheet.Columns(4).ColumnWidth =40
- sheet.Columns(5).ColumnWidth =10
- sheet.Columns(6).ColumnWidth =10
- sheet.Columns(1).WrapText =true
- sheet.Columns(2).WrapText =true
- sheet.Columns(4).WrapText =true
- '不显示网格线EXCEL.ActiveWindow.DisplayGridlines =False
- End If
- '-----------------------------------------------------------------------------
- ' Show properties of tables
- '-----------------------------------------------------------------------------
- Sub ShowProperties(mdl, sheet,SheetList)
- ' Show tables of the current model/packagerowsNum=0
- beginrow = rowsNum+1
- Dim rowIndex
- rowIndex=3
- ' For each tableoutput"begin"
- Dim tab
- For Each tab In mdl.tables
- ShowTable tab,sheet,rowIndex,sheetList
- rowIndex = rowIndex +1
- Next
- ifmdl.tables.count >0 then
- sheet.Range("A"& beginrow +1&":A"& rowsNum).Rows.Group
- end if
- output "end"
- End Sub
- '-----------------------------------------------------------------------------
- ' Show table properties
- '-----------------------------------------------------------------------------
- SubShowTable(tab, sheet,rowIndex,sheetList)
- IfIsObject(tab)Then
- Dim rangFlag
- rowsNum = rowsNum +1
- ' Show propertiesOutput"================================"
- sheet.cells(rowsNum, 1) =tab.name
- sheet.cells(rowsNum, 1).HorizontalAlignment=3
- sheet.cells(rowsNum, 2) =tab.code
- 'sheet.cells(rowsNum, 5).HorizontalAlignment=3
- 'sheet.cells(rowsNum, 6) = ""
- 'sheet.cells(rowsNum, 7) = "表说明"sheet.cells(rowsNum,3) =tab.comment
- 'sheet.cells(rowsNum, 8).HorizontalAlignment=3sheet.Range(sheet.cells(rowsNum,3),sheet.cells(rowsNum,7)).Merge
- '设置超链接,从目录点击表名去查看表结构
- '字段中文名 字段英文名 字段类型 注释 是否主键 是否非空 默认值sheetList.Hyperlinks.Add sheetList.cells(rowIndex,2),"","表结构"&"!B"&rowsNum
- rowsNum = rowsNum +1
- sheet.cells(rowsNum, 1) ="字段中文名"
- sheet.cells(rowsNum, 2) ="字段英文名"
- sheet.cells(rowsNum, 3) ="字段类型"
- sheet.cells(rowsNum, 4) ="注释"
- sheet.cells(rowsNum, 5) ="是否主键"
- sheet.cells(rowsNum, 6) ="是否非空"
- sheet.cells(rowsNum, 7) ="默认值"
- '设置边框sheet.Range(sheet.cells(rowsNum-1,1),sheet.cells(rowsNum,7)).Borders.LineStyle ="1"
- 'sheet.Range(sheet.cells(rowsNum-1, 4),sheet.cells(rowsNum, 9)).Borders.LineStyle = "1"
- '字体为10号sheet.Range(sheet.cells(rowsNum-1,1),sheet.cells(rowsNum,7)).Font.Size=10
- Dimcol' running column
- Dim colsNum
- colsNum =0
- for eachcolin tab.columns
- rowsNum = rowsNum +1
- colsNum = colsNum +1
- sheet.cells(rowsNum, 1) = col.name
- 'sheet.cells(rowsNum, 3) = ""
- 'sheet.cells(rowsNum, 4) = col.namesheet.cells(rowsNum,2) = col.code
- sheet.cells(rowsNum, 3) = col.datatype
- sheet.cells(rowsNum, 4) = col.comment
- Ifcol.Primary =true Then
- sheet.cells(rowsNum, 5) ="Y"
- Else
- sheet.cells(rowsNum, 5) =" "
- End If
- Ifcol.Mandatory =true Then
- sheet.cells(rowsNum, 6) ="Y"
- Else
- sheet.cells(rowsNum, 6) =" "
- End If
- sheet.cells(rowsNum, 7) = col.defaultvalue
- next
- sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,7)).Borders.LineStyle ="3"
- 'sheet.Range(sheet.cells(rowsNum-colsNum+1,4),sheet.cells(rowsNum,9)).Borders.LineStyle = "3"sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,7)).Font.Size =10
- rowsNum = rowsNum +2
- Output "FullDescription: "+tab.Name
- End If
- End Sub
- '-----------------------------------------------------------------------------
- ' Show List Of Table
- '-----------------------------------------------------------------------------
- Sub ShowTableList(mdl, SheetList)
- ' Show tables of the current model/package
- Dim rowsNo
- rowsNo=1
- ' For each tableoutput"begin"
- SheetList.cells(rowsNo, 1) ="主题"
- SheetList.cells(rowsNo, 2) ="表中文名"
- SheetList.cells(rowsNo, 3) ="表英文名"
- SheetList.cells(rowsNo, 4) ="表说明"
- rowsNo = rowsNo +1
- SheetList.cells(rowsNo, 1) = mdl.name
- Dim tab
- For Each tab In mdl.tables
- IfIsObject(tab)Then
- rowsNo = rowsNo +1
- SheetList.cells(rowsNo, 1) =""
- SheetList.cells(rowsNo, 2) =tab.name
- SheetList.cells(rowsNo, 3) =tab.code
- SheetList.cells(rowsNo, 4) =tab.comment
- End If
- Next
- SheetList.Columns(1).ColumnWidth =20
- SheetList.Columns(2).ColumnWidth =20
- SheetList.Columns(3).ColumnWidth =30
- SheetList.Columns(4).ColumnWidth =60
- output "end"
- End Sub
来源: http://www.bubuko.com/infodetail-1982994.html