Excel VBA 指定した図形(シェイプ)を指定個数作成する

スポンサーリンク
スポンサーリンク

指定した図形を指定した個数作成する方法

Excelには、四角や三角、円といった基本図形に加え
ブロック矢印、吹き出しなどの図形が182種類
組み込まれています。

Excelでの通常操作の場合、「挿入」メニュー内の
「図形」ボタンから図形を挿入しますが、
同じ図形を複数挿入したい場合、挿入の作業を
繰り返し行わなくてならず面倒です。

VBAでは、
Shapes【シェイプス】コレクション
AddShape【アドシェイプ】メソッドを使用して
図形をワークシートに挿入します。

組み込み図形のスタイルと図形の番号一覧表


※番号138はエクセルではサポートされていない図形になります。


指定した図形を指定個数アクティブシートに挿入するコード例

Sub 指定数図形作成()
Dim 図形数 As Long
Dim 図形番号 As Long
Dim i As Long
図形数 = Application.InputBox("作成する図形の数を入力してください。", Type:=1)
戻る:
図形番号 = Application.InputBox("作成する図形の番号を入力してください。", Type:=1)
For i = 1 To 図形数
On Error GoTo エラー処理
 ActiveSheet.Shapes.AddShape 図形番号, 20, 20, 100, 100
Next i
MsgBox 図形数 & "個の図形を作成します。" & vbCrLf & _
"図形は重なった状態で選択されています。" & vbCrLf & _
"書式を変更する場合は選択状態で変更してください。"
ActiveSheet.Shapes.SelectAll
Exit Sub
エラー処理:
MsgBox "図形番号が不正です。138を除く1~183の間の値を入力してください"
GoTo 戻る
End Sub

コードの解説

2行目
【Dim 図形数 As Long】

作成する図形の数を格納する
変数「図形数」を長整数型(Long)で
宣言しています。


3行目
【Dim 図形番号 As Long】

組み込み図形の定数の値を格納する
変数「図形番号」を長整数型(Long)で
宣言しています。


4行目
【Dim i As Long】

繰り返し処理で使用される
1から図形数分の値が順次格納される
カウンタ―変数「i」を長整数型(Long)で
宣言しています。


5行目
【図形数 = Application.InputBox(“作成する図形の数を入力してください。”, Type:=1)】

ApplicationオブジェクトのInputBoxメソッドを利用してユーザーから
作成する図形の数を入力してもらい、変数「図形数」に
格納します。引数Typeを1に設定することで数値のみ受け付ける
仕様にします。


6行目
【戻る:】

エラーが発生したときにGoToステートメントによって
処理が戻る位置の行ラベルです。


7行目
【図形番号 = Application.InputBox(“作成する図形の番号を入力してください。”, Type:=1)】

作成する図形の定数の値をユーザーに入力してもらい
変数「図形番号」に格納します。
図形番号は上記の一覧表から選択してください。


8行目
【For i = 1 To 図形数】

For文で繰り返し処理の始まりです。
1~変数「図形数」分の繰り返し処理を行い
図形を作成します。


9行目
【On Error GoTo エラー処理】

OnErrorステートメントとGoToステートメントを使用して
エラーが発生した場合、17行目の「エラー処理:」ラベルまで
処理をジャンプさせます。


10行目
【ActiveSheet.Shapes.AddShape 図形番号, 20, 20, 100, 100】

Shapes【シェイプス】コレクションの
AddShapeメソッドを使用して
上左から20ポイントの位置に高さ幅100ポイントの指定された
図形を挿入しています。


12行目~14行目
【MsgBox 図形数 & “個の図形を作成します。” & vbCrLf & _
“図形は重なった状態で選択されています。” & vbCrLf & _
“書式を変更する場合は選択状態で変更してください。”】

MsgBox関数を使用して
ユーザーにメッセージを伝えます。


15行目
【ActiveSheet.Shapes.SelectAll】

Shapes【シェイプス】コレクションの
SelectAll【セレクトオール】メソッドを使用して
挿入したすべてに図形を選択状態にします。


16行目
【Exit Sub】

Exit【エグジット】ステートメントで処理を抜けます。(終了)


17行目~19行目
【エラー処理:
MsgBox “図形番号が不正です。138を除く1~183の間の値を入力してください”
GoTo 戻る】

エラーが発生したとき
ユーザーが図形番号を1~183の間以外または138を指定した場合
エラー処理:のラベルまで処理がジャンプして
MsgBox関数でユーザーにメッセージを表示して
GoToステートメントで、図形番号を入力するところまで
処理をジャンプして戻します。


挿入される図形は重なった状態ですべて選択された状態になっています。
書式や大きさを変更する場合は選択状態で実行してください。
選択状態が解除された場合の為に、すべての図形を選択するコードと
ずべての図形を削除するコード例を載せますので
同じ標準モジュール内に設置してください。

アクティブシートの図形をすべて選択するコード例

Sub 全図形選択()
ActiveSheet.Shapes.SelectAll
End Sub

アクティブシートの図形をすべて削除するコード例

Sub 全図形削除()
ActiveSheet.Shapes.SelectAll
Selection.Delete
End Sub

以上で
指定した図形(シェイプ)を指定個数作成するに
ついての解説を終了します。
ありがとうございました。

スポンサーリンク
スポンサーリンク

フォローする

スポンサーリンク
スポンサーリンク