做了个自动生成流程图工具

对象 2023-11-28 10:43:41  64576

分类专栏：资讯

最近在研究如何使用VBA一键绘制流程图，对于没有Visio的我，就只能靠自己来做做工具啦。话不多说，下面来看看效果

虽然还有点缺陷，但已经够用了，判断和循环的连接线没有想到太好的方法，但手动插入线条能够自动吸附，后面的就简单啦

这里方便的地方在于，我只需要按位置摆放好数据，就可以自动根据文字画出形状，排版好，对于同一条直线上的，他可以自己自动连接好

这是数据

这是效果

下面我们来学学代码吧

01 主代码

Sub test()
Dim shp As Shape, arr, shp1 As Shape, shp2 As Shape
arr = ThisWorkbook.Sheets("数据").Range("A1").CurrentRegion.Value
ThisWorkbook.Sheets("流程图").DrawingObjects.Delete
For j = 1 To UBound(arr, 2)
    Set shp1 = Nothing
    Set shp = Nothing
    For i = 1 To UBound(arr)
        If arr(i, j) <> "" Then
            If i <> 1 Then Set shp1 = shp
            If InStr(1, arr(i, j), "开始") Or InStr(1, arr(i, j), "结束") Then
                shpAdd shp, startOrEnd, arr(i, j), 150 * j - 50, i * 60 - 30, 100, 40
            ElseIf InStr(1, arr(i, j), "输入") Or InStr(1, arr(i, j), "输出") Then
                shpAdd shp, inputOrOutput, arr(i, j), 150 * j - 50, i * 60 - 30, 100, 40
            ElseIf InStr(1, arr(i, j), "如果") Or InStr(1, arr(i, j), "循环") Then
                shpAdd shp, judge, arr(i, j), 150 * j - 50 - 15, i * 60 - 30, 130, 40
            Else
                shpAdd shp, process, arr(i, j), 150 * j - 50, i * 60 - 30, 100, 40
            End If
        End If
        If Not shp1 Is Nothing Then Set shp2 = connAdd(1, 1, shp1, 3, shp, 1)
    Next i
Next j
End Sub

第3行：将数据装入数组

第5行：循环数组列

第8行：循环数组行

第9-20行：如果数据不为空，则根据数据画形状，调用了ShpAdd过程

第21行：如果shp1<>nothing,则连接形状，这就是为什么第6-7行，我要清空shp1变量，每列第一个跟最后一个数据不需要连接

02 ShpAdd代码：

该代码用于创建形状

Public Enum shpType
    startOrEnd
    inputOrOutput
    process
    judge
End Enum
Sub shpAdd(shp As Shape, shpType1 As shpType, strText, iLeft, iTop, iWidth, iHeight)
    Dim shpT
    Select Case shpType1
    Case 0
        shpT = msoShapeFlowchartTerminator
    Case 1
        shpT = msoShapeFlowchartData
    Case 2
        shpT = msoShapeFlowchartProcess
    Case 3
        shpT = msoShapeFlowchartDecision
    End Select
    Set shp = ThisWorkbook.Sheets("流程图").Shapes.AddShape(shpT, iLeft, iTop, iWidth, iHeight)
    With shp.TextFrame2
        .TextRange.Text = strText
        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .VerticalAnchor = msoAnchorMiddle
        .TextRange.Font.Size = 11
        .TextRange.Font.Bold = True
        .TextRange.Font.Name = "微软雅黑"
    End With
    Set addShp = shp
End Sub

第1-6行：在程序开头定义了流程图需要的四种形状枚举

第9-18行：根据形状类型，获取对应的枚举编号

第19行：创建形状

第20-27行：处理形状内的文字格式

03 connAdd代码

该代码用于连接形状

Function connAdd(sType, shType, shp1 As Shape, icol, shp2 As Shape, jcol) As Shape
If shType = 1 Then shpT = msoConnectorStraight
Dim shp As Shape
Set shp = ThisWorkbook.Sheets("流程图").Shapes.AddConnector(shpT, 100, 100, 100, 100)
With shp
    .Line.EndArrowheadStyle = msoArrowheadTriangle
    .ConnectorFormat.BeginConnect shp1, icol
    .ConnectorFormat.EndConnect shp2, jcol
    If sType Then shp2.RerouteConnections
End With
Set connAdd = shp
End Function

第4行：创建连接符形状

第6行：设置连接线尾部为箭头形状

第7行：设置起始连接位置

第8行：设置结束连接位置

网站声明：如果转载，请联系本站管理员。否则一切后果自行承担。

本文链接：https://www.xckfsq.com/news/show.html?id=29064

赞同 0

评论 0 条

做了个自动生成流程图工具

相关文章

关注我们