zoukankan      html  css  js  c++  java
  • 把Visio文档中形状信息导出到XML文件的VBA代码

    从老外那里找来,做了一些修改,原文地址:http://www.vbaexpress.com/kb/getarticle.php?kb_id=506

    Option Explicit
     
    Public Sub LocationTable()
         'This routine will create a text file of the location and size of all 2-d shapes
         ' on the current page
        Dim shpObj     As Visio.Shape, celObj As Visio.Cell
        Dim ShpNo      As Integer, Tabchr     As String, localCent As Double
        Dim LocationX  As String, LocationY   As String
        Dim ShapeWidth As String, ShapeHeight As String
        Dim unit As String
        
        unit = "mm"
         'Open or create text file to write data
        Open "C:\temp\LocationTable.xml" For Output Shared As #1
         
        Tabchr = Chr(9'Tab
         
        Print #1"<?xml version=""1.0"" encoding=""gb2312"" ?>"
        Print #1"<document path="""; Visio.ActiveDocument.Path; """ name="""; Visio.ActiveDocument.Name; """>"
        Print #1"<shapes unit="""; unit; """>"
         
         
         'Loop Shapes collection
        For ShpNo = 1 To Visio.ActivePage.Shapes.Count
             
            Set shpObj = Visio.ActivePage.Shapes(ShpNo)
            If Not shpObj.OneD Then ' Only list the 2-D shapes
                 
                 'Get location Shape
                Set celObj = shpObj.Cells("pinx")
                localCent = celObj.Result(unit)
                LocationX = localCent ' Format(localCent, "000.0000")
                Set celObj = shpObj.Cells("piny")
                localCent = celObj.Result(unit)
                LocationY = Format(localCent, "000.0000")
                 
                 'Get Size Shape
                Set celObj = shpObj.Cells("width")
                localCent = celObj.Result(unit)
                ShapeWidth = Format(localCent, "000.0000")
                Set celObj = shpObj.Cells("height")
                localCent = celObj.Result(unit)
                ShapeHeight = Format(localCent, "0.0000")
                 
                 'Write values to Text file starting Name of Shape
                Print #1"<shape name="""; shpObj.Name; """ type="""; shpObj.Type; """ text="""; shpObj.Text; """ bounds="""; _
                 LocationX; ","; LocationY; ","; ShapeWidth; ","; ShapeHeight; """ />"
            End If
             
        Next ShpNo
        
        Print #1"</shapes>"
        Print #1"</document>"
         'Close Textfile
        Close #1
         
         'Clean Up
        Set celObj = Nothing
        Set shpObj = Nothing
    End Sub

      

  • 相关阅读:
    2014.3.3 图像旋转方法
    2014.2.23 datagridview显示图片的方法
    2016.10.8 文件读取和两种模式写入
    2016.8.11 DataTable合并及排除重复方法
    2016.8.17服务器端数据库用户导入导出方法 expdp和impdp
    2016.8.11 禁用360进程防护功能
    2016.7.27 VS搜索正则表达式,在UltraEdit中可选用Perl正则引擎,按C#语法搜索
    2016.6.18主窗体、子窗体InitializeComponent()事件、Load事件发生顺序以及SeleChanged事件的发生
    delphi之猥琐的webserver实现
    HTTP协议中GET、POST和HEAD的介绍
  • 原文地址:https://www.cnblogs.com/effun/p/2718540.html
Copyright © 2011-2022 走看看