VBAで図形操作を自動化【 すぐに使えるサンプルを紹介 】
それは、図形の変更を忘れてしまう!ということ
VBAを使えば図形の変更を忘れてしまう!というリスクがなくなり、ほかにもいろんなメリットがあります。
メリット・図形の変更忘れがなくなる
・図形の表示位置の調整に要する作業時間の削減
・ミスプリントによる紙の無駄遣いの削減
目次
図形の操作プログラムの紹介
ユーザーフォームに工事番号を入力しすると、
Sheet1(一覧表)の○列の値によって、Sheet2(工事契約書)内の図形の表示が変化する
というプログラムです。
※上記の動画ではユーザーフォームが映っていませんが、ユーザーフォームに工事番号を入力し、実行すると図形が変化。
下記のようにユーザーフォームが表示されている。
ユーザーフォームの使い方は
・仕事で使えるExcel VBA【 転記プログラム 】
・仕事で使えるExcel VBA【 プログラムの実行方法おすすめ3選 】
で詳しく紹介しています。
図形の操作プログラムの内容
モジュールに図形を操作するプログラムを作成します。
一覧表の○列目の値によって図形を表示または非表示させる
というプログラムを作成。
図形の非表示
プログラムの始まりで、Sheet内の図形を全て削除するというプログラムを記載
複数の図形の操作が必要な場合、図形一つ一つに表示・非表示のプログラムを記載すると無駄に長いプログラムになってしまう。
図形の表示
条件によって図形を表示させるので、関数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 |