エクセルで簡単なオートシェイプのマクロをつくりました マクロの実行とステップごとの実行の結果がちがってしまいます
オートシェイプを使った簡単な寸法線の入った図をマクロで書きました。 ステップごとだと期待どおりのアウトプットなのですが、ダイレクトにマクロを実行すると途中のステップがとんでしまうようです。 どうしてでしょうか。 教えてください。
1 Sub 寸法線1()
2 Dim l1, l2, l3, l4, lb, la1, la2, fig1, fig2, fig3, fig4 As Shape
3 x1 = 200
4 y1 = 500
5 x2 = x1 + 100
6 k = Cells(7, 5).Value / Cells(7, 4).Value
7 y2 = y1 - 100 * k
8 Set l1 = ActiveSheet.Shapes.AddLine(x1, y1, x2 + 20, y1)
9 Set l2 = ActiveSheet.Shapes.AddLine(x1, y1, x1, y2 - 15)
10 Set lb = ActiveSheet.Shapes.AddLine(x1, y1, x2, y2)
lb.Line.Weight = 2#
11 Set l3 = ActiveSheet.Shapes.AddLine(x2 + 5, y2, x2 + 20, y2)
12 Set l4 = ActiveSheet.Shapes.AddLine(x2, y2 - 5, x2, y2 - 15)
13 Set la1 = ActiveSheet.Shapes.AddLine(x2 + 12.5, y1 - 2, x2 + 12.5, y2 + 2)
14 la1.Line.BeginArrowheadStyle = msoArrowheadTriangle
15 la1.Line.BeginArrowheadLength = msoArrowheadLengthMedium
16 la1.Line.BeginArrowheadWidth = msoArrowheadWidthMedium
17 la1.Line.EndArrowheadStyle = msoArrowheadTriangle
18 la1.Line.EndArrowheadLength = msoArrowheadLengthMedium
19 la1.Line.EndArrowheadWidth = msoArrowheadWidthMedium
20 Set la2 = ActiveSheet.Shapes.AddLine(x1 + 2, y2 - 10, x2 - 2, y2 - 10)
21 la2.Line.BeginArrowheadStyle = msoArrowheadTriangle
22 la2.Line.BeginArrowheadLength = msoArrowheadLengthMedium
23 la2.Line.BeginArrowheadWidth = msoArrowheadWidthMedium
24 la2.Line.EndArrowheadStyle = msoArrowheadTriangle
25 la2.Line.EndArrowheadLength = msoArrowheadLengthMedium
26 la2.Line.EndArrowheadWidth = msoArrowheadWidthMedium
27 Set fig1 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
x1 - 10, y1 + 5, 17, 17)
28 fig1.Select
29 Selection.Characters.Text = Str(Cells(6, 3))
30 Selection.Characters.Font.Bold = True
31 Selection.ShapeRange.Line.Visible = msoFalse
32 Set fig2 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
x2 + 5, y2 - 20, 18, 18)
33 fig2.Select
34 Selection.Characters.Text = Str(Cells(7, 3))
35 Selection.Characters.Font.Bold = True
36 Selection.ShapeRange.Line.Visible = msoFalse
37 Set fig3 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
x1 + (x2 - x1) * 0.5 - 13, y2 - 32, 45, 17)
38 fig3.Select
39 Selection.Characters.Text = Str(Cells(7, 4))
40 Selection.ShapeRange.Line.Visible = msoFalse
41 Set fig4 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationUpward, _
x2 + 15, y1 - 0.5 * (y1 - y2) - 8, 17, 45)
42 fig4.Select
43 Selection.Characters.Text = Str(Cells(7, 5))
44 Selection.ShapeRange.Line.Visible = msoFalse
45 MsgBox "pause"
46 Call l1.Select
47 Call l2.Select(False)
48 Call l3.Select(False)
49 Call l4.Select(False)
50 Call lb.Select(False)
51 Call la1.Select(False)
52 Call la2.Select(False)
53 Call fig1.Select(False)
54 Call fig2.Select(False)
55 Call fig3.Select(False)
56 Call fig4.Select(False)
57 MsgBox "hit any"
58 Selection.ShapeRange.Group.Delete
59 End Sub
Cells(7, 5)=50
cells(7,4)=100
cells(6,3)=1
cells(7,3)=2
です。
左端に行番号をふってあります。 36から44まで飛んでしまいます。
節点 座標
X Y
1 0 0
2 100 50
お礼
ActiveSheet.ChartObjects(1).Activate ActiveChart.Shapes("SUB_LINE").Delete で削除することが出来ました ActiveChart.Shapesを探せませんでした ありがとうございました。