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

上周派到了个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 0

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 = 2 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(1).Characters
       vsoCharacters1.Begin = 0
       vsoCharacters1.End = 0
       vsoCharacters1.text = sourceSheet.Cells(i, 1).Value
Next sourceSheet.Activate End Sub

 

转载于:https://www.cnblogs.com/TheMiao/p/9657787.html

  • 0
    点赞
  • 7
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值