'******************************************************************************
'* File: pdm2excel.txt
'* Title: pdm export to excel
'* Purpose: To export the tables and columns to Excel
'* Model: Physical Data Model
'* Objects: Table, Column, View
'* Author: By
'* Created: 2014-11-28
'* Version: 1.0
'******************************************************************************
Option Explicit
Dim rowsNum,fontName,fontSize,tableCount,isFomart,isVisible
rowsNum = 0
tableCount = 1
fontName = "微软雅黑"
fontSize = 10
'-----------------------------------------------------------------------------
' 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 EXCEL, SHEET,SHEET1
set EXCEL = CREATEOBJECT("Excel.Application")
EXCEL.workbooks.add(-4167)'添加工作表
set sheet1 = EXCEL.workbooks(1).Sheets(1) '添加新sheet
sheet1.name = "目录"
sheet1.cells(1,1) = "中文名称"
sheet1.Columns(1).ColumnWidth = 40
sheet1.Columns(1).Font.Name = fontName
sheet1.Columns(1).Font.Size = fontSize
sheet1.cells(1,2) = "表名"
sheet1.Columns(2).ColumnWidth = 30
sheet1.Columns(2).Font.Name = fontName
sheet1.Columns(2).Font.Size = fontSize
sheet1.cells(1,3) = "注释"
sheet1.Columns(3).ColumnWidth = 50
sheet1.Columns(3).Font.Name = fontName
sheet1.Columns(3).Font.Size = fontSize
EXCEL.visible = true
ShowProperties Model
shortSheets EXCEL
End If
'-----------------------------------------------------------------------------
' Show properties of tables
'-----------------------------------------------------------------------------
Sub ShowProperties(mdl)
' Show tables of the current model/package
rowsNum=0
' For each table
output "begin"
Dim tab
For Each tab In mdl.tables
'循环处理每个表信息
ShowTable tab
Next
if mdl.tables.count > 0 then
'sheet.Range("A" & beginrow + 1 & ":A" & rowsNum).Rows.Group
end if
output "end"
End Sub
'-----------------------------------------------------------------------------
' Show table properties
'-----------------------------------------------------------------------------
Sub ShowTable(tab)
If IsObject(tab) Then
tableCount = tableCount + 1
'设置目录页信息
'sheet1.cells(tableCount,1) = tab.name
sheet1.Hyperlinks.Add sheet1.Range("A"&tableCount), "", tab.code&"!B1", "", tab.name
sheet1.cells(tableCount,1).Font.Name = fontName
sheet1.cells(tableCount,1).Font.Size = fontSize
sheet1.cells(tableCount,2) = tab.code
sheet1.cells(tableCount,3) = tab.comment
'创建新sheet页
set SHEET = EXCEL.workbooks(1).Sheets.Add
sheet.Name = tab.code
'设置列宽
sheet.Columns(1).ColumnWidth = 20
sheet.Columns(2).ColumnWidth = 20
sheet.Columns(3).ColumnWidth = 20
sheet.Columns(4).ColumnWidth = 10
sheet.Columns(5).ColumnWidth = 10
sheet.Columns(6).ColumnWidth = 30
'设置列字体
sheet.Columns(1).Font.Name = fontName
sheet.Columns(2).Font.Name = fontName
sheet.Columns(3).Font.Name = fontName
sheet.Columns(4).Font.Name = fontName
sheet.Columns(5).Font.Name = fontName
sheet.Columns(6).Font.Name = fontName
'设置列字号
sheet.Columns(1).Font.Size = fontSize
sheet.Columns(2).Font.Size = fontSize
sheet.Columns(3).Font.Size = fontSize
sheet.Columns(4).Font.Size = fontSize
sheet.Columns(5).Font.Size = fontSize
sheet.Columns(6).Font.Size = fontSize
Dim rangFlag
rowsNum = 1
' Show properties
Output "================================"
sheet.cells(rowsNum, 1) = tab.name
sheet.cells(rowsNum, 2) = tab.code
sheet.cells(rowsNum, 3) = tab.comment
rowsNum = rowsNum + 1
'设置列标题行字体和背景色
sheet.rows(rowsNum).Font.Bold = true
sheet.rows(rowsNum).Interior.Color = RGB(217,217,217)
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.Range(sheet.cells(rowsNum-1, 1),sheet.cells(rowsNum, 2)).Borders.LineStyle = "1"
'sheet.Range(sheet.cells(rowsNum-1, 4),sheet.cells(rowsNum, 6)).Borders.LineStyle = "1"
Dim col ' running column
Dim colsNum
colsNum = 0
for each col in tab.columns
rowsNum = rowsNum + 1
colsNum = colsNum + 1
sheet.cells(rowsNum, 1) = col.name
sheet.cells(rowsNum, 2) = col.code
sheet.cells(rowsNum, 3) = col.datatype
sheet.cells(rowsNum, 4) = col.primary
sheet.cells(rowsNum, 5) = col.defaultvalue
sheet.cells(rowsNum, 6) = col.comment
next
'sheet.Columns("A:F").AutoFit '自动列宽
'sheet.Range(sheet.cells(rowsNum-colsNum+1,1),sheet.cells(rowsNum,2)).Borders.LineStyle = "2"
'sheet.Range(sheet.cells(rowsNum-colsNum+1,4),sheet.cells(rowsNum,6)).Borders.LineStyle = "2"
rowsNum = rowsNum + 1
Output "FullDescription: " + tab.Name
End If
End Sub
'-----------------------------------------------------------------------------
' short sheets
'-----------------------------------------------------------------------------
Sub shortSheets(EXCEL)
For Each sheet In EXCEL.workbooks(1).Sheets
sheet.Move EXCEL.workbooks(1).Sheets(1)
Next
End Sub
分享到:
相关推荐
将pb数据表导出excel表,适用于PB9.0
pb 数据窗口导出EXCEL PB EXCEL 导出
PB DW快速导出EXCEL
pb数据窗口导出excel,替代pb自带导出功能,所见即所得。
关于pb技术文档,在pb导出数据窗口可以直接导出excel里面
PB数据窗口导出Excel的PBL,PB9版本,所见即所得,非常好用,只需要调用一个函数即可!
将PB中数据窗口导出EXCEL,所见即所得
pb9.0窗口数据完美导出到EXCEL中 dw2xls 把dw存成excel格式
pb数据窗口原样导出为excel,支持导出2003,2007两种格式,使用dll导出(非ole方式),无需安装excel, 速度极快,20万条数据只需要130秒。
使用pb开发应用软件经常会遇到导出excel功能,此类库可以按格式导出excel,使用方便简单
pb10导出excel源码
只需要把数据窗口或者数据对象丢到该控件中,就可以轻松导出到excel中,数据窗口或者数据对象不管是什么风格都可以。
可以支持分组,多标头,合计的数据窗口。 调用的如下: string ls_pathName,ls_FileName //路径+文件名,文件名 ...n_cst_dw2excel n_excel //用户对象 ...n_excel.OF_dw2Excel(dw_Excel,ls_pathName) end if
PB使用HTML格式导出Excel。使用PB数据窗口的saveas函数完成数据导出功能。
PB的datawindow导出到excel文件
测试过 7W多条100列只要不到5S excelserver.Workbooks.Open(ls_path)//打开 //ExcelServer.ActiveSheet.rows(2).insert //显示数据库列名时启用 ll_colnum = long(dw_1.Describe("DataWindow.Column.Count")) ...
powerbuild 导出Excel
能导出数据窗口,把数据窗口导出为excel
好用的dw2xls,我在powerbuilder9,11,12等版本中使用过。