第一篇博客,存储一些以前写过的代码吧,
visio 中vba资料还真不多,除了vb语法很多年没用完全不熟悉了以外,麻烦的就是各个对象 不熟悉了,还有资料难找,用宏记录了几个运行对象修改后得到的这些内容。
'excel表中的字段转变为visio中的uml图
Public Sub arrange()
Set excelobject = CreateObject("excel.application")
Set wb = excelobject.Workbooks.Open("C:\Users\zyc\Desktop\shape.xls") '打开excel文件'
Dim sheet1 As Object
'Dim sheet2 As excelobject.Worksheet
Set sheet1 = wb.Worksheets(1)
Dim recordLength As Integer
recordLength = sheet1.UsedRange.Rows.count '记录数量
recordLength = 12
Dim i As Integer
Dim j As Integer
Dim z As Integer
z = 2
Dim sumArray(1 To 12) As Variant
Dim DynArray() As String
For i = 1 To recordLength
j = 0
ReDim Preserve DynArray(1)
While (Len(sheet1.Cells(i + 1, j + 1)) > 0)
j = j + 1
ReDim Preserve DynArray(j)
DynArray(j) = sheet1.Cells(i + 1, j)
Wend
sumArray(i) = DynArray()
Call Macro1(DynArray, i)
Next i
End Sub
Sub Macro1(ByVal pArray As Variant, ByVal x As Integer)
Dim count As Integer
count = UBound(pArray)
Dim i As Integer
'Enable diagram services
Dim xoffset As Integer
Dim yoffset As Integer
Dim pId As Long
Dim DiagramServices As Integer
DiagramServices = ActiveDocument.DiagramServicesEnabled
ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150
xoffset = 2 * x
yoffset = 2 * x
Application.Windows.ItemEx("逻辑设计.vsdx").Activate
Dim pId As Integer
'uml组件 实体
Set a = Application.ActiveWindow.Page.Drop(Application.Documents.Item("DBUML_M.VSSX").Masters.ItemU("Entity"), xoffset, yoffset)
pId = a.ID
For i = 1 To count
If i = 1 Then
pId = pId + 2
Dim vsoCharacters1 As Visio.Characters
Set vsoCharacters1 = Application.ActiveWindow.Page.Shapes.ItemFromID16(pId).Characters
vsoCharacters1.Begin = 0
vsoCharacters1.End = 4
vsoCharacters1.Text = pArray(i)
End If
If i = 2 Then
pId = pId + 2
Dim vsoCharacters2 As Visio.Characters
Set vsoCharacters2 = Application.ActiveWindow.Page.Shapes.ItemFromID16(pId).Characters
vsoCharacters2.Begin = 0
vsoCharacters2.End = 4
vsoCharacters2.Text = pArray(i)
End If
If i = 3 Then
pId = pId + 5
Dim vsoCharacters3 As Visio.Characters
Set vsoCharacters3 = Application.ActiveWindow.Page.Shapes.ItemFromID(pId).Characters
vsoCharacters3.Begin = 0
vsoCharacters3.End = 4
vsoCharacters3.Text = pArray(i)
End If
If i = 4 Then
pId = pId + 4
Dim vsoCharacters4 As Visio.Characters
Set vsoCharacters4 = Application.ActiveWindow.Page.Shapes.ItemFromID(pId).Characters
vsoCharacters4.Begin = 0
vsoCharacters4.End = 4
vsoCharacters4.Text = pArray(i)
End If
If i > 4 Then
pId = pId + 4
Application.ActivePage.DropIntoList Application.Documents.Item("C:\Users\zyc\Desktop\地下水红线项目文本资料\逻辑设计.vsdx").Masters.ItemU("Attribute"), Application.ActivePage.Shapes.ItemFromID(a.ID), i
Dim vsoCharacters5 As Visio.Characters
Set vsoCharacters5 = Application.ActiveWindow.Page.Shapes.ItemFromID(pId).Characters
vsoCharacters5.Begin = 0
vsoCharacters5.End = 4
vsoCharacters5.Text = pArray(i)
End If
Next i
'Restore diagram services
ActiveDocument.DiagramServicesEnabled = DiagramServices
End Sub
输入
输出
使用visio2013
通用性方面还没有完全改好,勉强够用, 再修改吧。