Excel绘制交叉口流量流向图VBA程序.docx

Excel绘制交叉口流量流向图VBA程序 打开Excel，在Excel左上角编辑交叉口转向流量表,和定义斜交角度(东北角),新建宏文件DrawFlowMap,将文后代码复制进宏文件，执行宏文件,即可绘制交叉口流量流向图。 附代码：来自世界代码联盟，作者：一起玩狗的 Sub text(top_x, top_y, t) 定义文本框 ActiveSheet.Shapes.AddShape(msoShapeRectangle, top_x, top_y, 120, 120).Select Selection.Characters.text = t With Selection.Characters(Start:=1, length:=30).Font .Name = Times New Roman .FontStyle = 常规 .Size = 20 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.ShapeRange.Fill.Visible = msoTrue Selection.ShapeRange.Fill.Solid Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9 Selection.ShapeRange.Fill.Transparency = 0 Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0 Selection.ShapeRange.Line.Visible = msoFalse End Sub Sub DrawFlowMap() 画路口流量流向图 Dim F_to_T As Boolean Dim tt As String Dim factor As Double factor = 0.02 定义斜交角 Dim tha, tha1 As Single tha1 = Cells(2, 7) tha = Application.WorksheetFunction.Radians(tha1) 判断、清除图形 ActiveSheet.DrawingObjects.Select Selection.Delete 清除图形结束 东进口 tt = 东进口流量 Chr(10) 左转: Cells(2, 2) Chr(10) 直行: Cells(3, 2) Chr(10) 右转: Cells(4, 2) Call text(1550, 750, tt) 东进口直行 ActiveSheet.Shapes.AddLine(800, 800, 1500, 800).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255) Selection.ShapeRange.Line.Weight = Cells(3, 2) * factor 绘制出口箭头 ActiveSheet.Shapes.AddLine(725, 800, 801, 800).Select Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0) Selection.ShapeRange.Line.B