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

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

  1. 1、本文档共15页,可阅读全部内容。
  2. 2、有哪些信誉好的足球投注网站(book118)网站文档一经付费(服务费),不意味着购买了该文档的版权,仅供个人/单位学习、研究之用,不得用于商业用途,未经授权,严禁复制、发行、汇编、翻译或者网络传播等,侵权必究。
  3. 3、本站所有内容均由合作方或网友上传,本站不对文档的完整性、权威性及其观点立场正确性做任何保证或承诺!文档内容仅供研究参考,付费前请自行鉴别。如您付费,意味着您自己接受本站规则且自行承担风险,本站不退款、不进行额外附加服务;查看《如何避免下载的几个坑》。如果您已付费下载过本站文档,您可以点击 这里二次下载
  4. 4、如文档侵犯商业秘密、侵犯著作权、侵犯人身权等,请点击“版权申诉”(推荐),也可以打举报电话:400-050-0827(电话支持时间:9:00-18:30)。
查看更多
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

文档评论(0)

199****4744 + 关注
实名认证
内容提供者

该用户很懒,什么也没介绍

版权声明书
用户编号:7002121022000045

1亿VIP精品文档

相关文档