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组合所选直线,这样主刻度和次刻度都是组合图形,只要点一下鼠标就可以选中全部线条并编辑格式,直线再多也没有压力。