VBAで図形操作を自動化【 すぐに使えるサンプルを紹介 】

主にデスクワークをしている方で、図形の操作が必要となるExcelでの書類作成は意外と多いのではないでしょうか
・図形の〇をつける
・図形の横棒で斜線を引く
・図形の三角で印をつける
契約書や注文書を作成する際、以前使ったデータをコピーし、参考にしながら作成するという方法がよく使われますが、この方法には大きなリスクがあります。

それは、図形の変更を忘れてしまう!ということ

 

Right Caption

豆父ちゃん

私はよく忘れて上司に叱られています・・

VBAを使えば図形の変更を忘れてしまう!というリスクがなくなり、ほかにもいろんなメリットがあります。

メリット図形の変更忘れがなくなる

図形の表示位置の調整に要する作業時間の削減

ミスプリントによる紙の無駄遣いの削減

 

広告

図形の操作プログラムの紹介

ユーザーフォームに工事番号を入力しすると、

Sheet1(一覧表)の○列の値によって、Sheet2(工事契約書)内の図形の表示が変化する

というプログラムです。

※上記の動画ではユーザーフォームが映っていませんが、ユーザーフォームに工事番号を入力し、実行すると図形が変化。

下記のようにユーザーフォームが表示されている。

ユーザーフォームの使い方は
仕事で使えるExcel VBA【 転記プログラム 】

仕事で使えるExcel VBA【 プログラムの実行方法おすすめ3選 】

で詳しく紹介しています。

 

図形の操作プログラムの内容

モジュールに図形を操作するプログラムを作成します。

一覧表の○列目の値によって図形を表示または非表示させる

というプログラムを作成。

図形の非表示

プログラムの始まりで、Sheet内の図形を全て削除するというプログラムを記載

複数の図形の操作が必要な場合、図形一つ一つに表示・非表示のプログラムを記載すると無駄に長いプログラムになってしまう。

Pointプログラムの始まりで図形を全て削除することで、各図形を非表示にするというプログラムを省略することができる

 

図形の表示

条件によって図形を表示させるので、関数IFを使用。

For~Nextと関数IFを組み合わせて使う方法は下記の記事で詳しく紹介しています。

 

もしSheet(一覧表)の○列の値が「有」ならば、Sheet(注文書)の○セルで図形の丸を表示
もしSheet(一覧表)の○列の値が「無」ならば、Sheet(注文書)の○セルで図形の丸を表示

というプログラムを作成します。

 

 

次に、

Sheet(一覧表)の○列の値が「無」ならば、Sheet(注文書)で図形斜線を表示させる。

というプログラムを記載

 

Sheet(一覧表)の有、無を変更するだけでSheet(注文書)の図形の操作が可能に。

 

図形Shapes Addshapeの使い方

図形の種類

名前 説明
msoShapeRectangle 1 四角形
msoShapeParallelogram 2 平行四辺形
msoShapeTrapezoid 3 台形
msoShapeDiamond 4 ひし形
msoShapeRoundedRectangle 5 角丸四角形
msoShapeOctagon 6 八角形

などなど
図形の種類は100種類以上あるので、全て紹介するのは省略します。

図形Shapes Addshapeは下記のように使用

 

ActiveSheets.Shapes.AddShape(図形, 表示位置(右左), 表示位置(上下), 図形の大きさ(右左), 図形の大きさ(上下))

図形 に表の名前(アルファベット)を入れる

表示位置 図形の大きさ に数字を入れる

 

もしくは

 

ActiveSheets.Shapes.AddShape 図形(値),表示位置(右左),表示位置(上下),図形の大きさ(左右),図形の大きさ(上下)

図形 に表の値(数値)を入れる

表示位置 図形の大きさ に数字を入れる

アルファベットを使うか、数字を使うかは使いやすい方を使いましょう。

 

2つの方法を使いわけるとき、とても重要な注意事項があります。

注意事項・図形(アルファベット)を使用する場合、AddShapeの後カッコ()でくくる。

・図形(値)を使用する場合、AddShapeの後カッコ()でくくらない。

この違いをしっかり把握しておかなければ、システムエラーが発生したとき間違いを見つけることが困難になってしまいます。

 

図形Shapes AddLineの使い方

図形Shapes AddLineは下記のプログラムで使用

ActiveSheets.Shapes.AddLine(Range(“A1").Left, Range(“A1").Top , Range(“B1").Left, Range(“B1").Top ).Line
プログラムの赤色黄色斜線の始まり位置斜線の終わり位置を示しています。

 

A1セルの左上からB1セルの左上に斜線を引く
という意味のプログラムです。

 

微調整をしたい場合、それぞれのLeftやTopの後ろに+〇、-〇
といったように数値を入れて調整を行います。

終わりに

決まった様式に○や斜線を記入して書類を作成する業務をしている方は、図形を操作するExcel VBAを導入するべきです。

私の職場ではこの図形を操作するExcel VBAを導入してから、作業時間の削減やミス印刷による無駄紙の削減に繋がりました。

Excelで図形を操作する作業は意外と時間と手間がかかります。

図形を操作するVBAで作業の効率化を行いましょう。

今回作成したプログラム

標準モジュール

1 Sub 工事注文書()
2 """""""""""""Sheetの設定"""""""""""""
3 Dim Ash As Worksheet
4 Dim Bsh As Worksheet
5 Set Ash = ThisWorkbook.Worksheets(“一覧表")
6 Set Bsh = ThisWorkbook.Worksheets(“工事注文書")
7 """""""""""""ユーザーフォームで入力した値を変数iで取得""""""""""""’
8 i = UserForm1.TextBox1.Value
9 """""""""""""Sheet内の図形を削除"""""""""""""’
10 '現在表示している図形をリセット
11 Dim zukei As Shape
12 For Each zukei In Bsh.Shapes
13 On Error Resume Next
14 If zukei.TopLeftCell.Address >= Bsh.Cells(1, 1).Address Then
15 zukei.Delete
16 End If
17 If Err <> 0 Then
18 Err.Clear
19 End If
20 Next
21 """""""""""""一覧表から工事契約書へ値を転記する"""""""""""
22 ""’工事件名を転記""’
23 Bsh.Range(“H6") = Ash.Cells(i + 2, 2)
24 Bsh.Range(“H6").HorizontalAlignment = xlLeft
25 ""’工事場所を転記""’
26 Bsh.Range(“H8") = Ash.Cells(i + 2, 3)
27 Bsh.Range(“H8").HorizontalAlignment = xlLeft
28 ""’工期(着手)を転記""’
29 Bsh.Range(“H10") = Ash.Cells(i + 2, 4)
30 Bsh.Range(“H10").HorizontalAlignment = xlCenter
31 Bsh.Range(“H10").NumberFormatLocal = “ggge年m月d日
32 “""’工期(竣工)を転記""’
33 Bsh.Range(“P10") = Ash.Cells(i + 2, 5)
34 Bsh.Range(“P10").HorizontalAlignment = xlCenter
35 Bsh.Range(“P10").NumberFormatLocal = “ggge年m月d日
36 “""’請負金額を転記""’
37 Bsh.Range(“L12") = Ash.Cells(i + 2, 6)
38 Bsh.Range(“L12").HorizontalAlignment = xlCenter
39 Bsh.Range(“L12").NumberFormatLocal = “#,###
40 “""’消費税を転記""’
41 Bsh.Range(“R14") = Bsh.Range(“L12").Value * 0.1
42 Bsh.Range(“R14").HorizontalAlignment = xlCenter
43 Bsh.Range(“R14").NumberFormatLocal = “#,###
44 “""’支給材料の有無(図形〇を表示)""’
45 If Ash.Cells(i + 2, 11) = “有" Then
46 With Bsh.Shapes.AddShape(msoShapeOval, 368, 358, 14, 14)
47 .Fill.Visible = msoFalse
48 .Line.Weight = 1
49 .Line.ForeColor.RGB = vbBlock
50 End With
51 ElseIf Ash.Cells(i + 2, 11) = “無" Then
52 With Bsh.Shapes.AddShape(msoShapeOval, 402, 358, 14, 14)
53 .Fill.Visible = msoFalse
54 .Line.Weight = 1
55 .Line.ForeColor.RGB = vbBlock
56 End With
57 Else
58 End If
59 ""’貸与品の有無(図形〇を表示)""’
60 If Ash.Cells(i + 2, 12) = “有" Then
61 With Bsh.Shapes.AddShape(msoShapeOval, 368, 378, 14, 14)
62 .Fill.Visible = msoFalse
63 .Line.Weight = 1
64 .Line.ForeColor.RGB = vbBlock
65 End With
66 ElseIf Ash.Cells(i + 2, 12) = “無" Then
67 With Bsh.Shapes.AddShape(msoShapeOval, 402, 378, 14, 14)
68 .Fill.Visible = msoFalse
69 .Line.Weight = 1
70 .Line.ForeColor.RGB = vbBlock
71 End With
72 Else
73 End If
74 ""’発生品の有無(図形〇を表示)""’
75 If Ash.Cells(i + 2, 13) = “有" Then
76 With Bsh.Shapes.AddShape(msoShapeOval, 368, 396, 14, 14)
77 .Fill.Visible = msoFalse
78 .Line.Weight = 1
79 .Line.ForeColor.RGB = vbBlock
80 End With
81 ElseIf Ash.Cells(i + 2, 13) = “無" Then
82 With Bsh.Shapes.AddShape(msoShapeOval, 402, 396, 14, 14)
83 .Fill.Visible = msoFalse
84 .Line.Weight = 1
85 .Line.ForeColor.RGB = vbBlock
86 End With
87 Else
88 End If
89 ""’工事数量調書の有無(図形線を表示)""’
90 If Ash.Cells(i + 2, 14) = “有" Then
91 With Bsh.Shapes.AddLine(Bsh.Range(“I24").Left, Bsh.Range(“I24").Top + 6, Bsh.Range(“P24").Left, Bsh.Range(“P24").Top + 6).Line
92 .Weight = 1
93 .ForeColor.RGB = vbBlock
94 End With
95 With Bsh.Shapes.AddLine(Bsh.Range(“I24").Left, Bsh.Range(“I24").Top + 12, Bsh.Range(“P24").Left, Bsh.Range(“P24").Top + 12).Line
96 .Weight = 1
97 .ForeColor.RGB = vbBlock
98 End With
99 Else
100 End If
101 ""’示方書等の有無(図形線を表示)""’
102 If Ash.Cells(i + 2, 15) = “有" Then
103 With Bsh.Shapes.AddLine(Bsh.Range(“I25").Left, Bsh.Range(“I25").Top + 6, Bsh.Range(“P25").Left, Bsh.Range(“P25").Top + 6).Line
104 .Weight = 1
105 .ForeColor.RGB = vbBlock
106 End With
107 With Bsh.Shapes.AddLine(Bsh.Range(“I25").Left, Bsh.Range(“I25").Top + 12, Bsh.Range(“P25").Left, Bsh.Range(“P25").Top + 12).Line
108 .Weight = 1
109 .ForeColor.RGB = vbBlock
110 End With
111 Else
112 End If
113 ""’工事数量調書の有無(図形線を表示)""’
114 If Ash.Cells(i + 2, 16) = “有" Then
115 With Bsh.Shapes.AddLine(Bsh.Range(“I26").Left, Bsh.Range(“I26").Top + 6, Bsh.Range(“P26").Left, Bsh.Range(“P26").Top + 6).Line
116 .Weight = 1
117 .ForeColor.RGB = vbBlock
118 End With
119 With Bsh.Shapes.AddLine(Bsh.Range(“I26").Left, Bsh.Range(“I26").Top + 12, Bsh.Range(“P26").Left, Bsh.Range(“P26").Top + 12).Line
120 .Weight = 1
121 .ForeColor.RGB = vbBlock
122 End With
123 Else
124 End If
125 ""発注者住所を転記""’
126 Bsh.Range(“J33") = Ash.Cells(i + 2, 8)
127 Bsh.Range(“J33").HorizontalAlignment = xlLeft
128 """発注者氏名を転記""’
129 Bsh.Range(“J35") = Ash.Cells(i + 2, 7)
130 Bsh.Range(“J35").IndentLevel = 2
131 """注文者住所を転記""’
132 Bsh.Range(“J37") = Ash.Cells(i + 2, 10)
133 Bsh.Range(“J37").HorizontalAlignment = xlLeft
134 """注文者氏名を転記""’
135 Bsh.Range(“J39") = Ash.Cells(i + 2, 9)
136 Bsh.Range(“J39").IndentLevel = 2
137 End Sub

 

ユーザーフォーム

1 Private Sub CommandButton1_Click()
2 Call 工事注文書
3 End Sub
4
5 Private Sub TextBox1_Change()
6 End Sub
7
8 Private Sub UserForm_Click()
9
End Sub
10
11 Private Sub UserForm_Layout()
12 UserForm1.Left = 750
13 UserForm1.Top = 200
14 End Sub