自动在Excel中对齐流程图

时间:2017-01-25 09:29:45

标签: excel vba charts visio flowchart

在Excel中有一个流程图,需要像我们在Visio中那样自动对齐它。在Excel中有没有可用的代码?

感谢。

我已经编写了一个vba代码,但它没有像Visio那样提供漂亮的结果

Sub auto_align()
    On Error Resume Next

    'Compile the diagram
    Call Compiler

    'Clear array values
    For i = 0 To 99
        numberofchildnodes(i) = 0
        numberofnodesineachrow(i) = 0
        listofnodes(i) = ""
        nodeindexarray(i) = 0
        parentnodearray(i) = 0
        rownumberarray(i) = 0
        columnnumberarray(i) = 0
        numberofnodesineachrowarray(i) = 0
    Next

   'Get amount of space that must be given in the diagram between each nodes
   rowspac = InputBox("Enter the space between rows, usually 100", "Test Modelling Tool")
   colspac = InputBox("Enter the space between adjacent nodes, usually 200", "Test Modelling Tool")

  'Find the listof nodes
  i = 2
  Do While Sheet6.Cells(1, i) <> ""

    listofnodes(i - 2) = Sheet6.Cells(1, i)
    i = i + 1

  Loop
  'Find the number of nodes
    noofnodes = i - 2
    orignoofnodes = noofnodes

  'Find the begining node
    For i = 2 To noofnodes + 1

    b = False
    E = False

        j = 2
        Do While Sheet6.Cells(j, 1) <> ""

            If Sheet6.Cells(j, i) = "B" Then
                b = True
            End If
            If Sheet6.Cells(j, i) = "E" Then
                E = True
            End If

            j = j + 1

        Loop

        If b = True And E = False Then

            strt_node = Sheet6.Cells(1, i)
            Exit For

        End If

    Next

    'Initialize values for start node
    For i = 0 To noofnodes - 1

        If listofnodes(i) = strt_node Then
            Exit For
        End If

    Next

    parentnodearray(i) = 0
    nodeindexarray(i) = 1
    rownumberarray(i) = 1
    columnnumberarray(i) = 1

    nodeindex = 1

    'Call row order algorithm

    'Initialize row number and column number
    r = 1
    cc = 1
    dumnod = 1
    'Loop until all the nodes has row number updated
    Do

        'Traverse through all the nodes
        For i = 0 To noofnodes - 1

            'If row number matches the exiting row number, update the row number for childs
            If rownumberarray(i) = r Then
                Call roworderalg(listofnodes(i))
            End If

        Next

        'Increment the row
        r = r + 1
        'reinitialize column number
        cc = 1

        'Check if row number updated for all the nodes
        rowupdatedforallnodes = True
        For i = 0 To noofnodes - 1
            If rownumberarray(i) = 0 Then
                rowupdatedforallnodes = False
            End If
        Next

        'Sort all the array inorder to maintain the order of calling the nodes in each row
        Call BubbleSort

    Loop While rowupdatedforallnodes = False

    'Find the number of rows
    r = rownumberarray(0)
    For i = 0 To noofnodes - 1

        If rownumberarray(i) > r Then

            r = rownumberarray(i)

        End If

    Next

    'From last row minus 1 row to 1st row
    i = r - 1
    Do

        For j = 0 To noofnodes - 1
            'if a node falls in given row number
            If rownumberarray(j) = i Then
                'update the column number as sum of child nodes column number divided by number of child nodes
                columnnumberarray(j) = findcolumnnumberofparent(j)

            End If

        Next
    i = i - 1
    Loop While i <> 0


    i = 2
    Do While Sheet6.Cells(1, i) <> ""
        'Move all the nodes in the diagram according to row and column position which is obtained by multiplying the space factor obtained from the user
        x = findnumberofnode(Sheet6.Cells(1, i))
        Sheet1.Shapes(Sheet6.Cells(1, i)).Top = rownumberarray(x) * rowspac
        Sheet1.Shapes(Sheet6.Cells(1, i)).Left = columnnumberarray(x) * colspac

        i = i + 1
    Loop

    'Reroute all the connectors to ensure there is no intersection between connectors
    i = 2
    Do While Sheet6.Cells(i, 1) <> ""

        Sheet1.Shapes(Sheet6.Cells(i, 1)).RerouteConnections
        i = i + 1

    Loop
    Sheet1.Activate


End Sub

0 个答案:

没有答案