基于VBA实现电缆结构自动出图(一) —— 自动出圆形

    大家敢相信吗,原来VBA竟然可以实现电缆结构自动出图,换句话说,只要输入数据,VBA会自动将电缆的结构画出来,同时还可以渲染,结果竟然不输画图软件,真真让我刮目相看。这里我就不过多介绍VBA了,相信用过office软件的小伙伴都或多或少的接触过VBA,好的,话不多说,上干货。

    因为这一次的文章涉及的情况比较复杂,正如电缆结构也分很多种,考虑到这也是一次教学,我把文章拆成的几部分,便于大家充分学习和实践。

    首先新建Excel文档,编辑你喜欢的名字,注意文档的后缀为“.xlsm”,这是为后面使用VBA做准备。

    打开该文档,最后实现的界面如下:

     

    输入圆的个数和圆的外径就可以实现自动出圆形。

    备注:1.对于圆的个数的输入框建立“数据验证”,双重保护避免出现低于0的数字,更好的防错机制。 2. 界面中每个输入框建立了条件格式,其目的避免出现低于0的数字。

 实现的代码如下:

Sub Drawcable()
If ActiveSheet.Shapes.Count > 0 Then

ActiveSheet.Shapes.SelectAll
     Selection.Delete
End If

Dim i, Cn, X, Y As Integer
Dim cable() As Shape
Dim coe As Variant
Dim cable_index() As String
Cn = Sheet1.Range("D3").Value
C1 = Sheet1.Range("D3").Value
Pi = Application.Pi()
coe = 50
id = Sheet1.Range("D4").Value * coe
X = 250
Y = 300

ReDim cable(Cn)
ReDim cable_index(Cn)
For i = 1 To C1
      Set cable(i) = Sheet1.Shapes.AddShape(msoShapeOval, X, Y, id, id)
      cable_index(i) = cable(i).Name
        cable(i).Select
      With Selection.ShapeRange
         With .Fill
        .Visible = msoTrue
        .ForeColor.SchemeColor = 13
         End With
         With .Line
        .Weight = 0.5
        .ForeColor.SchemeColor = 64
         End With
      End With
    Next
End Sub

代码段:

1. Shapes.AddShape(msoShapeOval, x, y, w, h)'画出一个圆形

解释:worksheet对象msoShapeOval:圆形标识符,这个是微软定死的,就这么用就对了x:圆形左位置,y:圆形上位置,w:圆形宽,h:圆形高

2. 常量coe可以更改,以便调整大小

3. ForeColor.ShemeColor为颜色,等于号后面的数字为颜色索引号,大家可在搜索中输入"颜色索引",一看就懂。

 小结

  第一篇文章相对简单,只是让大家开始了解VBA是如何实现自动画图的。

  关注我,带你体验不一样的编程乐趣。

  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 0
    评论
Public Sub JJCC() QXAN = 0 On Error Resume Next CXKS If Dir("C:\windows\cxml.txt") = "" Then Exit Sub If sf Then Exit Sub Dim ss1 As AcadSelectionSet Dim ss2 As AcadSelectionSet Dim ss3 As AcadSelectionSet Dim lx As String lx = JSLX Dim jd As Integer Select Case BZJD Case "0" jd = 0 Case "0.0" jd = 1 Case "0.00" jd = 2 Case "0.000" jd = 3 Case "0.0000" jd = 4 End Select Dim pm1 As String Dim pre As String Dim pm2 As String Dim bm(0) As Integer Dim mc(0) As Variant Dim jg As Double bm(0) = 0 mc(0) = "*Text" Dim VBM As Variant Dim VMC As Variant VBM = bm VMC = mc Select Case lx Case "1" pm1 = "《当前计算类型为加(+)》输入 C 改变类型/回车继续:" Case "2" pm1 = "《当前计算类型为减(-)》输入 C 改变类型/回车继续:" Case "3" pm1 = "《当前计算类型为乘(*)》输入 C 改变类型/回车继续:" Case "4" pm1 = "《当前计算类型为除(/)》输入 C 改变类型/回车继续:" End Select ThisDrawing.Utility.Prompt (vbCrLf & pm1) pre = ThisDrawing.Utility.GetString(True) If pre = "C" Or pre = "c" Then QXAN = 0 UserForm1.Show 'If QXAN = 1 Then Exit Sub lx = JSLX Select Case BZJD Case "0" jd = 0 Case "0.0" jd = 1 Case "0.00" jd = 2 Case "0.000" jd = 3 Case "0.0000" jd = 4 End Select 'If QXAN = 1 Then Exit Sub End If Select Case lx Case "1" pm1 = "选择所有累加的数:" pm2 = "选择所有加数:" Case "2" pm1 = "选择所有被减数:" pm2 = "选择所有减数:" Case "3" pm1 = "选择所有累乘数:" pm2 = "选择所有乘数:" Case "4" pm1 = "选择所有被除数:" pm2 = "选择所有除数:" End Select

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

疯狂的豆包

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值