vbs脚本(PDM转Excel)

冷不防 2024-05-02 20:13 74阅读 0赞

## 1. 操作步骤 ##

工具:powerdesigner 16.5

快捷键：ctrl+shift+x

执行：点击“run”

![d6c08d02f42f4bfebd68683d32a1431f.png][]

说明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博客][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博客][VBA_colorIndex _color _backcolor-CSDN]

![4ed9c93ef952dc58c58e047ded3096d0.png][]

[d6c08d02f42f4bfebd68683d32a1431f.png]: https://image.dandelioncloud.cn/pgy_files/images/2024/05/02/b8167ac0069e4bcf8da5f82641bb36d6.png
[vbs _excel_ _ ._vbs _sheet1-CSDN]: https://blog.csdn.net/llbacyal/article/details/9208545
[VBA_colorIndex _color _backcolor-CSDN]: https://blog.csdn.net/xuemanqianshan/article/details/103626920
[4ed9c93ef952dc58c58e047ded3096d0.png]: https://image.dandelioncloud.cn/pgy_files/images/2024/05/02/16e6ea37fe114e3b88d01fc1177dc45e.png