図形をかんたんに作成する方法【EXCEL_VBA】

VBAで図形を簡単に作成する方法を紹介します。

仕組みと流れです。
①エクセルで画像の名前や縦、横の長さを入力したリストを作成する
②VBA起動
③図形化したい製品名の列を選択
③図形が作成される

今回は、下記のリストを作成しました。

VBAを起動し、リストを選択すると下記のような図形が作成されます。

動画も公開してます。

リストの縦、横を変更すれば、図形のサイズも変わります。
図形に塗布される色は、コードのRGB値を変えることで変更可能です。
そのほかいろんなカスタマイズが可能です。

コードです。

Sub 図形作成()

With ThisWorkbook.Sheets("リスト")

Dim sc As Range
'キャンセルが押されたら終了'
On Error GoTo ERR1
Set sc = Application.InputBox(Prompt:="図形化したい製品名を選択してください(列A)", Type:=8)
On Error GoTo 0


Dim mysc As Variant
For Each mysc In sc '区分を判別'
   If mysc.Value <> "" Then 'select caseに設定している区分が含まれていたら'
       If InStr(mysc.Offset(, 1).Value, "合格") Or InStr(mysc.Offset(, 1).Value, "保留") _
       Or InStr(mysc.Offset(, 1).Value, "不合格") > 0 Then
       
       'オートシェイプ作成'
       Dim myshape As Shape  '引数Leftに"*60"をすることで右にずらしながら表示する'
       Set myshape = .Shapes.AddShape(Type:=msoShapeRectangle, Left:=mysc.Row * 60, Top:=50, _
       Height:=.Cells(mysc.Row, "C").Value, Width:=.Cells(mysc.Row, "D").Value)
       
       '品目リストに基づいてRGB値設定'
       Dim iro As String
       Select Case mysc.Offset(, 1).Value
           Case Is = "合格"
           iro = RGB(153, 204, 255)
           Case Is = "保留"
           iro = RGB(250, 191, 143)
           Case Is = "不合格"
           iro = RGB(255, 45, 45)
       End Select
              
       '色をつける'
       myshape.Fill.ForeColor.RGB = iro
              
       
       '図形に名前とサイズを書き込み'
       myshape.TextFrame.Characters.Text = _
       mysc.Value & vbLf & mysc.Offset(, 2) & vbLf & mysc.Offset(, 3)
       
       End If
   End If
Next

End With

ERR1:

End Sub