excel表中的字段转变为visio中的uml图

第一篇博客，存储一些以前写过的代码吧，

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

通用性方面还没有完全改好，勉强够用， 再修改吧。