标签：VBA Name 刻度 Shapes ActiveDocument 坐标 制作 shp3 shp2

VBA制作坐标图

word、ppt经常要制作图形，例如坐标图，有许多纵横线，有时需要批量制作，手工极不方便，线间距也不好调节，还有设置网格线的粗细、箭头、颜色等等，这时用VBA就可以发挥优势。
一、要求：
每间隔5格主刻度线加粗显示，组合成一个图；次刻度线较细，组合成一个图。便于批量设置主刻度和次刻度的格式。各条线间距相等

4个组合图形构成坐标图

主刻度线组合成一个

次刻度线组合成一个
二、程序

Sub coordinate()
 Dim shp1 As Shape, shp2() As Shape, shp3() As Shape
 j = 1
 k = 1
 ReDim shp2(1 To 1)
 ReDim shp3(1 To 1)
 For i = 1 To 36
  Set shp1 = addln(100 + 5 * (i - 1), 100, 100 + 5 * (i - 1), 275)
  If (i - 1) Mod 5 = 0 Then
    shp1.Name = "shp" & "i" & i
    Set shp2(j) = ActiveDocument.Shapes("shp" & "i" & i)
    With shp2(j)
     .Line.Weight = 1
    End With
    j = j + 1
    ReDim Preserve shp2(1 To j)
  Else
    shp1.Name = "shp" & "k" & i
    Set shp3(k) = ActiveDocument.Shapes("shp" & "k" & i)
    k = k + 1
    ReDim Preserve shp3(1 To k)
    End If
 Next
For i = LBound(shp2) To UBound(shp2) - 1
  ActiveDocument.Shapes.Range(Array(shp2(i).Name)).Select (msoFalse)
Next
Selection.ShapeRange.Group
For i = LBound(shp3) To UBound(shp3) - 1
  ActiveDocument.Shapes.Range(Array(shp3(i).Name)).Select (msoFalse)
Next
Selection.ShapeRange.Group
 j = 1
 k = 1
 ReDim shp2(1 To 1)
 ReDim shp3(1 To 1)
For i = 1 To 36
  Set shp1 = addln(100, 100 + 5 * (i - 1), 275, 100 + 5 * (i - 1))
  If (i - 1) Mod 5 = 0 Then
    shp1.Name = "shp" & "i2" & i
    Set shp2(j) = ActiveDocument.Shapes("shp" & "i2" & i)
    With shp2(j)
      .Line.Weight = 1
    End With
    j = j + 1
    ReDim Preserve shp2(1 To j)
  Else
    shp1.Name = "shp" & "k2" & i
    Set shp3(k) = ActiveDocument.Shapes("shp" & "k2" & i)
    k = k + 1
    ReDim Preserve shp3(1 To k)
  End If
 Next
For i = LBound(shp2) To UBound(shp2) - 1
  ActiveDocument.Shapes.Range(Array(shp2(i).Name)).Select (msoFalse)
Next
Selection.ShapeRange.Group
For i = LBound(shp3) To UBound(shp3) - 1
  ActiveDocument.Shapes.Range(Array(shp3(i).Name)).Select (msoFalse)
Next
Selection.ShapeRange.Group
End Sub
Function addline(x1, y1, x2, y2)
    Dim arrPoint(1 To 2, 1 To 2) As Single
    Set addln = ActiveDocument.Shapes.addline(x1, y1, x2, y2)
    With addln.Line
      .ForeColor.RGB = RGB(0, 0, 0)
      .Weight = 0.5
    End With
End Function

三、关键点
将所画直线编号并加上name属性，用可变数组存储，ActiveDocument.Shapes.Range(Array(shp2(i).Name)).Select (msoFalse)可以批量选择主刻度和次刻度线，不加“msoFalse”是无法多重选择的。
Selection.ShapeRange.Group组合所选直线，这样主刻度和次刻度都是组合图形，只要点一下鼠标就可以选中全部线条并编辑格式，直线再多也没有压力。

标签：VBA,Name,刻度,Shapes,ActiveDocument,坐标,制作,shp3,shp2
来源： https://blog.csdn.net/zhl555666/article/details/117717504

本站声明： 1. iCode9 技术分享网（下文简称本站）提供的所有内容，仅供技术学习、探讨和分享；
2. 关于本站的所有留言、评论、转载及引用，纯属内容发起人的个人观点，与本站观点和立场无关；
3. 关于本站的所有言论和文字，纯属内容发起人的个人观点，与本站观点和立场无关；
4. 本站文章均是网友提供，不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属；如您发现该文章侵犯了您的权益，可联系我们第一时间进行删除；
5. 本站为非盈利性的个人网站，所有内容不会用来进行牟利，也不会利用任何形式的广告来间接获益，纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。