VBA: 怎样批量数据从Excel派出到Visio

时间：2023-12-21 11:09:38

上周派到了个case, 是批量从Excel导出数据导Visio每个图形中.

花了些时间实现了这个功能.

原理如下:

  1. 打开Excel
  2. 新建/打开表单
  3. 指向所选择的表单
  4. 遍历所在列的所有数据
  5. 打开Visio
  6. 建立/打开Visio页面(Visio是和Excel一样, 需要建立指定页面.)
  7. 指向所选择的Visio页面.
  8. 打开diagram service 服务
  9. 遍历所有数据在新的图形中做文字.

代码如下:

Sub Test11()

Dim rowCount As Long

Dim sourceSheet As Worksheet

Dim targetWorksheet As Worksheet

Dim copyTimes As Integer

Dim vsoPage As Page

Set sourceSheet = Worksheets("Sheet1")

Dim FName As String

Dim VsApp As Object

On Error Resume Next

Set VsApp = GetObject(, "Visio.Application")

   If VsApp Is Nothing Then

       Set VsApp = CreateObject("Visio.Application")

           If VsApp Is Nothing Then

               MsgBox "Can't connect to Visio"

           Exit Sub

           End If

   End If

On Error GoTo 

FName = "D:\drawing.vsdm"

VsApp.Documents.Open FName

VsAppPage = "Page-1"

VsApp.ActivePage = VsAppPage

Cancel = True

 'Enable diagram services

Dim DiagramServices As Integer

DiagramServices = VsApp.ActiveDocument.DiagramServicesEnabled

VsApp.ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150

   For i =  To sourceSheet.UsedRange.Rows.Count

       'MsgBox sourceSheet.Cells(i, 1).Value

       VsApp.Application.Windows.ItemEx("drawing.vsdm").Activate

       VsApp.ActivePage.Drop VsApp.Application.Documents.Item("BASIC_U.VSSX").Masters.ItemU("Square"), 3.128788, 9.25

       Set vsoCharacters1 = VsApp.ActiveWindow.Selection().Characters

       vsoCharacters1.Begin =

       vsoCharacters1.End =

       vsoCharacters1.text = sourceSheet.Cells(i, 1).Value
Next sourceSheet.Activate End Sub

相关文章