vbs脚本(PDM转Excel)

1. 操作步骤

工具:powerdesigner 16.5

快捷键：ctrl+shift+x

执行：点击“run”

说明1：可复制以下脚本，执行pdm转excel；

说明2：表名长度不可超过31个字符,否则执行会中断；

说明3：以下格式仅用于支持当前需求，如果需要调整样式及导出顺序，可参考目录3、目录4中vbs对excel的操作，修改函数 ExportTable 或 函数 AddSheet

2. 脚本

'******************************************************************************
'* File:     Exported_Excel_page.vbs
'* Purpose:  分目录递归，查找当前PDM下所有表，并导出Excel
'******************************************************************************

Option Explicit
ValidationMode = True
InteractiveMode = im_Batch

'-----------------------------------------------------------------------------
' 主函数
'-----------------------------------------------------------------------------
' 获取当前活动模型
Dim mdl ' 当前的模型
Set mdl = ActiveModel
Dim EXCEL,catalog,sheet,catalogNum,rowsNum,linkNum
rowsNum = 1
catalogNum = 1
linkNum = 1

If (mdl Is Nothing) Then
    MsgBox "There is no Active Model"
Else
    SetCatalog
    ListObjects(mdl)
End If

'----------------------------------------------------------------------------------------------
' 子过程，用于扫描当前包并从当前包中打印对象的信息，然后对当前包的所有子包再次调用相同的子过程
'----------------------------------------------------------------------------------------------
Private Sub ListObjects(fldr)
    output "Scanning " & fldr.code
    Dim obj ' 运行对象
    For Each obj In fldr.children
        ' 调用子过程来打印对象上的信息
        DescribeObject obj
    Next
    ' 进入子包
    Dim f ' 运行文件夹
    For Each f In fldr.Packages
        '调用子程序扫描子程序包
        ListObjects f
    Next
End Sub

'-----------------------------------------------------------------------------
' 子过程，用于在输出中打印当前对象的信息
'-----------------------------------------------------------------------------
Private Sub DescribeObject(CurrentObject)
    if not CurrentObject.Iskindof(cls_NamedObject) then exit sub
    if CurrentObject.Iskindof(cls_Table) then 
        AddSheet CurrentObject
        ExportTable CurrentObject, sheet
        ExportCatalog CurrentObject
    else
        output "Found "+CurrentObject.ClassName+" """+CurrentObject.Name+""", Created by "+CurrentObject.Creator+" On "+Cstr(CurrentObject.CreationDate)   
    End if
End Sub

'----------------------------------------------------------------------------------------------
' 设置Excel的sheet页
'----------------------------------------------------------------------------------------------
Sub SetExcel()
    Set EXCEL= CreateObject("Excel.Application")

    ' 使Excel通过应用程序对象可见。
    EXCEL.Visible = True
    EXCEL.workbooks.add(-4167)'添加工作表
    EXCEL.workbooks(1).sheets(1).name ="pdm"
    set sheet = EXCEL.workbooks(1).sheets("pdm")

    ' 将一些文本放在工作表的第一行
	sheet.cells(rowsNum, 1).Value = "是否主键"
	sheet.Cells(rowsNum, 2).Value = "字段名"
	sheet.Cells(rowsNum, 3).Value = "字段描述"
	sheet.Cells(rowsNum, 4).Value = "类型"
	sheet.cells(rowsNum, 5).Value = "非空"
	sheet.Cells(rowsNum, 6).Value = "约束"
	sheet.cells(rowsNum, 7).Value = "缺省值"
	sheet.cells(rowsNum, 8).Value = "描述"
End Sub

'----------------------------------------------------------------------------------------------
' 导出目录结构
'----------------------------------------------------------------------------------------------
Sub ExportCatalog(tab)
    catalogNum = catalogNum + 1
    catalog.cells(catalogNum, 1).Value = tab.parent.name
    catalog.cells(catalogNum, 2).Value = tab.code
    catalog.cells(catalogNum, 3).Value = tab.comment
    '设置超链接
    catalog.Hyperlinks.Add catalog.cells(catalogNum,2), "",tab.code&"!A2"
End Sub 

'----------------------------------------------------------------------------------------------
' 导出sheet页
'----------------------------------------------------------------------------------------------
Sub ExportTable(tab, sheet)
    Dim col ' 运行列
    Dim colsNum
    colsNum = 0
    for each col in tab.columns
        colsNum = colsNum + 1
        rowsNum = rowsNum + 1
		'是否主键
		If col.Primary = true Then
            sheet.cells(rowsNum, 1) = "Y" 
        Else
            sheet.cells(rowsNum, 1) = "" 
        End If
		'字段名
		sheet.Cells(rowsNum, 2).Value = col.code
		'字段描述
		sheet.Cells(rowsNum, 3).Value = col.name
		'类型
		sheet.Cells(rowsNum, 4).Value = col.datatype
		'非空
		If col.Mandatory = true Then
            sheet.cells(rowsNum, 5) = "Y" 
        Else
            sheet.cells(rowsNum, 5) = "" 
        End If
		'约束
		If col.Primary = true Then
            sheet.cells(rowsNum, 6) = "主键" 
        Else
            sheet.cells(rowsNum, 6) = "" 
        End If
		'缺省值
		If col.defaultvalue = "NULL" Then
			sheet.cells(rowsNum, 7).Value = ""
		Else
			sheet.cells(rowsNum, 7).Value = col.defaultvalue
		END If
		'备注
		sheet.Cells(rowsNum, 8).Value = col.comment
    next
    output "Exported table: "+ +tab.Code+"("+tab.Name+")"
End Sub 

'----------------------------------------------------------------------------------------------
' 设置Excel目录页
'----------------------------------------------------------------------------------------------
Sub SetCatalog()
    Set EXCEL= CreateObject("Excel.Application")
    
    ' 使Excel通过应用程序对象可见。
    EXCEL.Visible = True
    EXCEL.workbooks.add(-4167)'添加工作表
    EXCEL.workbooks(1).sheets(1).name ="表结构"
    EXCEL.workbooks(1).sheets.add
    EXCEL.workbooks(1).sheets(1).name ="目录"
    set catalog = EXCEL.workbooks(1).sheets("目录")

    catalog.cells(catalogNum, 1) = "模块"
    catalog.cells(catalogNum, 2) = "表名"
    catalog.cells(catalogNum, 3) = "表注释"
    
    ' 设置列宽和自动换行
    catalog.Columns(1).ColumnWidth = 20
    catalog.Columns(2).ColumnWidth = 25
    catalog.Columns(3).ColumnWidth = 55
    
    '设置首行居中显示
    
    catalog.Range(catalog.cells(1,1),catalog.cells(1,3)).HorizontalAlignment = 3
    '设置首行字体加粗
    catalog.Range(catalog.cells(1,1),catalog.cells(1,3)).Font.Bold = True
End Sub 


'----------------------------------------------------------------------------------------------
' 新增sheet页
'----------------------------------------------------------------------------------------------
Sub AddSheet(tab)
    EXCEL.workbooks(1).Sheets(2).Select
    EXCEL.workbooks(1).sheets.add
    EXCEL.workbooks(1).sheets(2).name = tab.code
    set sheet = EXCEL.workbooks(1).sheets(tab.code)
	'设置标题
	sheet.cells(1,1).Value = tab.code+"("+tab.comment+")"
    rowsNum = 2
    '将一些文本放在工作表的第一行
    sheet.cells(rowsNum, 1).Value = "是否主键"
	sheet.Cells(rowsNum, 2).Value = "字段名"
	sheet.Cells(rowsNum, 3).Value = "字段描述"
	sheet.Cells(rowsNum, 4).Value = "类型"
	sheet.cells(rowsNum, 5).Value = "非空"
	sheet.Cells(rowsNum, 6).Value = "约束"
	sheet.cells(rowsNum, 7).Value = "缺省值"
	sheet.cells(rowsNum, 8).Value = "描述"
    
    '设置列宽
    sheet.Columns(1).ColumnWidth = 6
    sheet.Columns(2).ColumnWidth = 14
    sheet.Columns(3).ColumnWidth = 12
    sheet.Columns(4).ColumnWidth = 10
    sheet.Columns(5).ColumnWidth = 5
    sheet.Columns(6).ColumnWidth = 5
    sheet.Columns(7).ColumnWidth = 10
    sheet.Columns(8).ColumnWidth = 14

    '设置首行居中显示
    sheet.Range(sheet.cells(2,1),sheet.cells(2,8)).HorizontalAlignment = 3
    '设置首行字体加粗
    sheet.Range(sheet.cells(2,1),sheet.cells(2,8)).Font.Bold = True
	'设置背景色
	sheet.Range(sheet.cells(2,1),sheet.cells(2,8)).Interior.colorindex = 23
	'合并单元格
	sheet.Range("A1:H1").Merge
	sheet.Range(sheet.cells(1,1),sheet.cells(1,8)).HorizontalAlignment = 2
	
    linkNum = linkNum + 1
    '设置超链接
    sheet.Hyperlinks.Add sheet.cells(1,1), "","目录"&"!B"&linkNum
End Sub 

3. vbscript 中对excel常见操作

转载地址：vbs 对excel的操作 删除、修改单元格，设置字体、背景色 ._vbs 清空sheet1-CSDN博客

dim oExcel,oWb,oSheet
Set oExcel= CreateObject("Excel.Application")
Set oWb = oExcel.Workbooks.Open("E:/其他/新装电话表.xls")
Set oSheet = oWb.Sheets("Sheet1")
MsgBox oSheet.Range("B2").Value '#提取单元格B2内容
'.....
3、如果是XP系统，可以使用如下代码
Dim objFileDlg
Set objFileDlg = CreateObject("UserAccounts.CommonDialog")
objFileDlg.Filter = "Excel File (*.xls) |*.xls"
If objFileDlg.ShowOpen Then
msgbox "您选择的文件是：" & objFileDlg.FileName & vbCrLf
End If
VBS控制Excel的一些常见方法：
(一) 使用动态创建的方法
首先创建 Excel 对象，使用ComObj:
oExcel = CreateObject( "Excel.Application" )
1) 显示当前窗口：
oExcel.Visible = True
2) 更改 Excel 标题栏：
oExcel.Caption = "应用程序调用 Microsoft Excel"
3) 添加新工作簿：
oExcel.WorkBooks.Add
4) 打开已存在的工作簿：
oExcel.WorkBooks.Open( "C:/Excel/Demo.xls" )
5) 设置第2个工作表为活动工作表：
oExcel.WorkSheets(2).Activate
或
oExcel.WorksSheets( "Sheet2" ).Activate
6) 给单元格赋值：
oExcel.Cells(1,4).Value = "第一行第四列"
7) 设置指定列的宽度（单位：字符个数），以第一列为例：
oExcel.ActiveSheet.Columns(1).ColumnsWidth = 5
8) 设置指定行的高度（单位：磅）（1磅＝0.035厘米），以第二行为例：
oExcel.ActiveSheet.Rows(2).RowHeight = 1/0.035 ' 1厘米
9) 在第8行之前插入分页符：
oExcel.WorkSheets(1).Rows(8).PageBreak = 1
10) 在第8列之前删除分页符：
oExcel.ActiveSheet.Columns(4).PageBreak = 0
11) 指定边框线宽度：
oExcel.ActiveSheet.Range( "B3:D4" ).Borders(2).Weight = 3
1-左 2-右 3-顶 4-底 5-斜( / ) 6-斜( / )
12) 清除第一行第四列单元格公式：
oExcel.ActiveSheet.Cells(1,4).ClearContents
13) 设置第一行字体属性：
oExcel.ActiveSheet.Rows(1).Font.Name = "隶书"
oExcel.ActiveSheet.Rows(1).Font.Color = clBlue
oExcel.ActiveSheet.Rows(1).Font.Bold = True
oExcel.ActiveSheet.Rows(1).Font.UnderLine = True
14) 进行页面设置：
a.页眉：
oExcel.ActiveSheet.PageSetup.CenterHeader = "报表演示"
b.页脚：
oExcel.ActiveSheet.PageSetup.CenterFooter = "第&P页"
c.页眉到顶端边距2cm：
oExcel.ActiveSheet.PageSetup.HeaderMargin = 2/0.035
d.页脚到底端边距3cm：
oExcel.ActiveSheet.PageSetup.HeaderMargin = 3/0.035
e.顶边距2cm：
oExcel.ActiveSheet.PageSetup.TopMargin = 2/0.035
f.底边距2cm：
oExcel.ActiveSheet.PageSetup.BottomMargin = 2/0.035
g.左边距2cm：
oExcel.ActiveSheet.PageSetup.LeftMargin = 2/0.035
h.右边距2cm：
oExcel.ActiveSheet.PageSetup.RightMargin = 2/0.035
i.页面水平居中：
oExcel.ActiveSheet.PageSetup.CenterHorizontally = 2/0.035
j.页面垂直居中：
oExcel.ActiveSheet.PageSetup.CenterVertically = 2/0.035
k.打印单元格网线：
oExcel.ActiveSheet.PageSetup.PrintGridLines = True
15) 拷贝操作：
a.拷贝整个工作表：
oExcel.ActiveSheet.Used.Range.Copy
b.拷贝指定区域：
oExcel.ActiveSheet.Range( "A1:E2" ).Copy
c.从A1位置开始粘贴：
oExcel.ActiveSheet.Range.( "A1" ).PasteSpecial
d.从文件尾部开始粘贴：
oExcel.ActiveSheet.Range.PasteSpecial
16) 插入一行或一列：
a. oExcel.ActiveSheet.Rows(2).Insert
b. oExcel.ActiveSheet.Columns(1).Insert
17) 删除一行或一列：
a. oExcel.ActiveSheet.Rows(2).Delete
b. oExcel.ActiveSheet.Columns(1).Delete
18) 打印预览工作表：
oExcel.ActiveSheet.PrintPreview
19) 打印输出工作表：
oExcel.ActiveSheet.PrintOut
20) 工作表保存：
if not oExcel.ActiveWorkBook.Saved then
oExcel.ActiveSheet.PrintPreview
21) 工作表另存为：
oExcel.SaveAs( "C:/Excel/Demo1.xls" )
22) 放弃存盘：
oExcel.ActiveWorkBook.Saved = True
23) 关闭工作簿：
oExcel.WorkBooks.Close
24) 退出 Excel：
oExcel.Quit
(二) 使用VBS 控制Excle二维图
1）选择当第一个工作薄第一个工作表
set oSheet=oExcel.Workbooks(1).Worksheets(1)
2）增加一个二维图
achart=oSheet.chartobjects.add(100,100,200,200)
3）选择二维图的形态
achart.chart.charttype=4
4）给二维图赋值
set series=achart.chart.seriescollection
range="sheet1!r2c3:r3c9"
series.add range,true
5）加上二维图的标题
achart.Chart.HasTitle=True
achart.Chart.ChartTitle.Characters.Text=" Excle二维图"
6）改变二维图的标题字体大小
achart.Chart.ChartTitle.Font.size=18
7）给二维图加下标说明
achart.Chart.Axes(xlCategory, xlPrimary).HasTitle = True
achart.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "下标说明"
8）给二维图加左标说明
achart.Chart.Axes(xlValue, xlPrimary).HasTitle = True
achart.Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "左标说明"
9）给二维图加右标说明
achart.Chart.Axes(xlValue, xlSecondary).HasTitle = True
achart.Chart.Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "右标说明"
10）改变二维图的显示区大小
achart.Chart.PlotArea.Left = 5
achart.Chart.PlotArea.Width = 223
achart.Chart.PlotArea.Height = 108

这个是vbscript的，方法在javascript里都是通用的，不过语法略有不同希望对你有帮助
1、 建立Excel对象
set objExcelApp = CreateObject("Excel.Application")
objExcelApp.DisplayAlerts = false    不显示警告
objExcelApp.Application.Visible = false    不显示界面
2、 新建Excel文件
objExcelApp.WorkBooks.add
set objExcelBook = objExcelApp.ActiveWorkBook
set objExcelSheets = objExcelBook.Worksheets
set objExcelSheet = objExcelBook.Sheets(1)
3、 读取已有Excel文件
strAddr = Server.MapPath(".")
objExcelApp.WorkBooks.Open(strAddr & "/Templet/Table.xls")
set objExcelBook = objExcelApp.ActiveWorkBook
set objExcelSheets = objExcelBook.Worksheets
set objExcelSheet = objExcelBook.Sheets(1)
4、 另存Excel文件
objExcelBook.SaveAs strAddr & "/Temp/Table.xls"
5、 保存Excel文件
objExcelBook.Save    （笔者测试时保存成功，页面报错。）
6、 退出Excel操作
objExcelApp.Quit 一定要退出
set objExcelApp = Nothing
三、 ASP操作Excel生成数据表
1、 在一个范围内插入数据
objExcelSheet.Range("B3:k3").Value = Array("67", "87", "5", "9", "7", "45", "45", "54", "54", "10")
2、 在一个单元格内插入数据
objExcelSheet.Cells(3,1).Value="Internet Explorer"
3、 改变单元格文字颜色
objExcelSheet.Cells(3,1).Font.Color=vbred
4、 单元格四周画线条
objExcelSheet.Cells(3.1).Borders(1).LineStyle =1
objExcelSheet.Cells(3.1).Borders(2).LineStyle =1
objExcelSheet.Cells(3.1).Borders(3).LineStyle =1
objExcelSheet.Cells(3.1).Borders(4).LineStyle =1
       区域中间画线条
objExcelSheet.Range(“A1:G7”).Borders(7).LineStyle =1
objExcelSheet.Range(“A1:G7”).Borders(8).LineStyle =1

8、 单元格设定背景色
objExcelSheet.Cells(3.1).Interior.colorindex=17
9、 合并单元格
objExcelSheet.Range(“A1:G7”).Merge
10、 设置左右对齐方式
2 left   3 middle   4 right
objExcelSheet.Range("A1").HorizontalAlignment = 2
11、 设置上下对齐方式
2 为居中
objExcelSheet.Range("A1")..VerticalAlignment = 2
四、 ASP操作Excel生成Chart图
1、 创建Chart图
objExcelApp.Charts.Add
2、 设定Chart图种类
objExcelApp.ActiveChart.ChartType = 97
注：二维折线图，4；二维饼图，5；二维柱形图，51
3、 设定Chart图标题
objExcelApp.ActiveChart.HasTitle = True
objExcelApp.ActiveChart.ChartTitle.Text = "A test Chart"
4、 通过表格数据设定图形
objExcelApp.ActiveChart.SetSourceData objExcelSheet.Range("A1:k5"),1
5、 直接设定图形数据（推荐）
objExcelApp.ActiveChart.SeriesCollection.NewSeries
objExcelApp.ActiveChart.SeriesCollection(1).Name = "=""333"""
objExcelApp.ActiveChart.SeriesCollection(1).Values = "={1,4,5,6,2}"
6、 绑定Chart图
objExcelApp.ActiveChart.Location 1
7、 显示数据表
objExcelApp.ActiveChart.HasDataTable = True
8、 显示图例
objExcelApp.ActiveChart.DataTable.ShowLegendKey = True

4. VBA中的颜色，colorIndex 或color 或backcolor

转载地址：

VBA中的颜色，colorIndex 或color 或backcolor-CSDN博客