要做数据源的整理,需要将Mysql数据库表的结构导出到Excel表里面做文档记录;
第一个Sheet是所有表格的列表,其他的Sheet是每一个表格的详细字段以及注释说明.
选择好连接的数据库以后,ctrl+shift+x 弹出执行脚本界面,输入如下代码就会生成 Excel
Option Explicit
Dim rowsNum
Dim splitTabName
rowsNum = 0
'-----------------------------------------------------------------------------
' 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, BOOK, SHEET
Set EXCEL = CreateObject("Excel.Application")
EXCEL.Visible = True
Set BOOK = EXCEL.Workbooks.Add(-4167) '新建工作簿
BOOK.Sheets(1).Name = "数据库表结构"
Set SHEET = EXCEL.workbooks(1).sheets("数据库表结构")
ShowProperties Model, SHEET
EXCEL.visible = true
'设置列宽和自动换行
SHEET.Columns(1).ColumnWidth = 10
SHEET.Columns(2).ColumnWidth = 30
SHEET.Columns(3).ColumnWidth = 20
SHEET.Columns(1).WrapText =true
SHEET.Columns(2).WrapText =true
SHEET.Columns(3).WrapText =true
End If
'-----------------------------------------------------------------------------
' Show properties of tables
'-----------------------------------------------------------------------------
Sub ShowProperties(mdl, sheet)
' 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,sheet
Next
if mdl.tables.count > 0 then
sheet.Range("A" & beginrow + 1 & ":A" & rowsNum).Rows.Group
end if
output "end"
End Sub
'-----------------------------------------------------------------------------
' 数据表查询
'-----------------------------------------------------------------------------
Sub ShowTable(tab, sheet)
If IsObject(tab) Then
Dim rangFlag
sheet.cells(1, 1) = "序号"
sheet.cells(1, 2) = "表名"
sheet.cells(1, 3) = "表含义"
'设置边框
sheet.Range(sheet.cells(1, 1),sheet.cells(1, 3)).Borders.LineStyle = "1"
'设置背景颜色
sheet.Range(sheet.cells(1, 1),sheet.cells(1, 3)).Interior.ColorIndex = "19"
rowsNum = rowsNum + 1
sheet.cells(rowsNum+1, 1) = rowsNum
sheet.cells(rowsNum+1, 2) = tab.code
sheet.cells(rowsNum+1, 3) = tab.comment
'设置边框
sheet.Range(sheet.cells(rowsNum+1,1),sheet.cells(rowsNum+1,3)).Borders.LineStyle = "2"
'增加Sheet
BOOK.Sheets.Add , BOOK.Sheets(BOOK.Sheets.count)
'截取右边开始的31个字符
splitTabName = Right(tab.code, 31)
BOOK.Sheets(rowsNum+1).Name = Right(tab.code, 31)
Dim shtn
Set shtn = EXCEL.workbooks(1).sheets(splitTabName)
'设置列宽和换行
shtn.Columns(1).ColumnWidth = 20
shtn.Columns(2).ColumnWidth = 20
shtn.Columns(3).ColumnWidth = 20
shtn.Columns(4).ColumnWidth = 20
shtn.Columns(1).WrapText =true
shtn.Columns(2).WrapText =true
shtn.Columns(3).WrapText =true
shtn.Columns(4).WrapText =true
'设置列标题
shtn.cells(1, 1) = "字段中文名"
shtn.cells(1, 2) = "字段名"
shtn.cells(1, 3) = "字段类型"
shtn.cells(1, 4) = "注释"
'设置边框
shtn.Range(shtn.cells(1, 1),shtn.cells(1, 2)).Borders.LineStyle = "1"
shtn.Range(shtn.cells(1, 3),shtn.cells(1, 4)).Borders.LineStyle = "1"
'设置背景颜色
shtn.Range(shtn.cells(1, 1),shtn.cells(1, 2)).Interior.ColorIndex = "19"
shtn.Range(shtn.cells(1, 3),shtn.cells(1, 4)).Interior.ColorIndex = "19"
Dim col ' running column
Dim colsNum
Dim rNum
colsNum = 0
rNum = 0
for each col in tab.columns
rNum = rNum + 1
colsNum = colsNum + 1
shtn.cells(rNum+1, 1) = col.name
shtn.cells(rNum+1, 2) = col.code
shtn.cells(rNum+1, 3) = col.datatype
shtn.cells(rNum+1, 4) = col.comment
next
shtn.Range(shtn.cells(rNum-colsNum+2,1),shtn.cells(rNum+1,3)).Borders.LineStyle = "2"
rNum = rNum + 1
Output "FullDescription: " + tab.Name
End If
End Sub
核心代码段是:
sheet.cells(1, 1) = "序号"
sheet.cells(1, 2) = "表名"
sheet.cells(1, 3) = "表含义"
'设置边框
sheet.Range(sheet.cells(1, 1),sheet.cells(1, 3)).Borders.LineStyle = "1"
'设置背景颜色
sheet.Range(sheet.cells(1, 1),sheet.cells(1, 3)).Interior.ColorIndex = "19"
rowsNum = rowsNum + 1
sheet.cells(rowsNum+1, 1) = rowsNum
sheet.cells(rowsNum+1, 2) = tab.code
sheet.cells(rowsNum+1, 3) = tab.comment
这是设置第一个Sheet的每一列都是什么内容;
'设置列宽和换行
shtn.Columns(1).ColumnWidth = 20
shtn.Columns(2).ColumnWidth = 20
shtn.Columns(3).ColumnWidth = 20
shtn.Columns(4).ColumnWidth = 20
shtn.Columns(1).WrapText =true
shtn.Columns(2).WrapText =true
shtn.Columns(3).WrapText =true
shtn.Columns(4).WrapText =true
'设置列标题
shtn.cells(1, 1) = "字段中文名"
shtn.cells(1, 2) = "字段名"
shtn.cells(1, 3) = "字段类型"
shtn.cells(1, 4) = "注释"
'设置边框
shtn.Range(shtn.cells(1, 1),shtn.cells(1, 2)).Borders.LineStyle = "1"
shtn.Range(shtn.cells(1, 3),shtn.cells(1, 4)).Borders.LineStyle = "1"
'设置背景颜色
shtn.Range(shtn.cells(1, 1),shtn.cells(1, 2)).Interior.ColorIndex = "19"
shtn.Range(shtn.cells(1, 3),shtn.cells(1, 4)).Interior.ColorIndex = "19"
这是设置数据库导出的内容,我的这里只是设置了字段中文名,字段名,字段类型和注释,如果有其他的要求,可自行设置
'增加Sheet
BOOK.Sheets.Add , BOOK.Sheets(BOOK.Sheets.count)
'截取右边开始的31个字符
splitTabName = Right(tab.code, 31)
BOOK.Sheets(rowsNum+1).Name = Right(tab.code, 31)
这一段代码是由于Excel中每一个Sheet的名称长度限制为31个字符,在这里我做了一个截取,从每一个数据表名称的右边开始截取31个字符.