【マクロ】Withステートメント２つを簡略する為には？

以下コードは、以下の内容のマクロを、２つ同じ種類の物を連続して
書いただけです

当該マクロを、もう少し簡略して書くことはできますか？
アドバイス等でも良いので、教えて下さい

【マクロ内容】
・画像を作成
・画像にマクロを登録する


【コード】
Sub sample()
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 60, 60, 60, 60)

.Fill.ForeColor.RGB = RGB(220, 220, 220)

.Line.ForeColor.RGB = RGB(220, 220, 220)

.Name = "あいうえお"

With .TextFrame.Characters
.Text = "不要行削除"
.Font.Size = 16


End With

.Top = Range("d1").Top

.Left = Range("d1").Left

End With

ActiveSheet.Shapes("あいうえお").OnAction = "copy"

With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 60, 60, 60, 60)

.Fill.ForeColor.RGB = RGB(220, 220, 220)

.Line.ForeColor.RGB = RGB(220, 220, 220)

.Name = "かきこ"

With .TextFrame.Characters
.Text = "重複"
.Font.Size = 16


End With

.Top = Range("h1").Top

.Left = Range("h1").Left

End With

ActiveSheet.Shapes("かきこ").OnAction = "かきくけこ"

End Sub

No.2 ベストアンサー 回答者： tatsumaru77 回答日時： 2025/01/28 09:33

No1の方のアドバイスに従って、修正してみました。

Sub samaple2()
Call my_shape("あいうえお", "不要行削除", "d1", "copy")
Call my_shape("かきこ", "重複", "h1", "かきくけこ")
End Sub
Sub my_shape(name As String, text As String, rng As String, act As String)
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 60, 60, 60, 60)
.Fill.ForeColor.RGB = RGB(220, 220, 220)
.Line.ForeColor.RGB = RGB(220, 220, 220)
.name = name
With .TextFrame.Characters
.text = text
.Font.size = 16
End With
.Top = Range(rng).Top
.Left = Range(rng).Left
End With
ActiveSheet.Shapes(name).OnAction = act
End Sub

この回答へのお礼

いつもありがとうございます
大変、参考になりました

お礼日時：2025/02/08 09:03

No.3 回答者： amerikaumare 回答日時： 2025/02/03 06:06

こういう質問は得意（元情報システム部）なのですが、歳を取って長いコードをかくのが苦手なので　GoogleGemini　に丸投げしまし。

以下はその回答です。

以下に、ご提示いただいたコードを簡略化する例と、さらに応用的な方法をご紹介します。

1. 繰り返し処理と配列の活用
VBAでは、Forループを使って同じ処理を繰り返すことができます。
また、配列を使って複数のオブジェクトの情報をまとめて管理することで、コードを簡略化できます。

Sub sample()

Dim buttonNames As Variant
Dim buttonTexts As Variant
Dim buttonActions As Variant
Dim positions As Variant
Dim i As Long

' 各ボタンの情報を配列に格納
buttonNames = Array("あいうえお", "かきこ")
buttonTexts = Array("不要行削除", "重複")
buttonActions = Array("copy", "かきくけこ")
positions = Array("d1", "h1")

' 繰り返し処理でボタンを作成
For i = 0 To UBound(buttonNames)

With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 60, 60, 60, 60)
.Fill.ForeColor.RGB = RGB(220, 220, 220)
.Line.ForeColor.RGB = RGB(220, 220, 220)
.Name = buttonNames(i)
With .TextFrame.Characters
.Text = buttonTexts(i)
.Font.Size = 16
End With
.Top = Range(positions(i)).Top
.Left = Range(positions(i)).Left
End With

ActiveSheet.Shapes(buttonNames(i)).OnAction = buttonActions(i)

Next i

End Sub
このコードでは、ボタンの名前、テキスト、マクロ名、配置場所をそれぞれ配列に格納し、Forループを使ってまとめて処理しています。
これにより、ボタンの数が増えてもコードの変更箇所を最小限に抑えることができます。

2. 関数化
ボタンの作成処理を関数として独立させることで、コードの可読性を高めることができます。

Sub sample()

CreateButton "あいうえお", "不要行削除", "copy", "d1"
CreateButton "かきこ", "重複", "かきくけこ", "h1"

End Sub

Function CreateButton(name As String, text As String, action As String, position As String)

With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 60, 60, 60, 60)
.Fill.ForeColor.RGB = RGB(220, 220, 220)
.Line.ForeColor.RGB = RGB(220, 220, 220)
.Name = name
With .TextFrame.Characters
.Text = text
.Font.Size = 16
End With
.Top = Range(position).Top
.Left = Range(position).Left
End With

ActiveSheet.Shapes(name).OnAction = action

End Function
このコードでは、CreateButtonという関数を作成し、ボタンの情報を引数として渡しています。
これにより、sampleマクロのコードが簡潔になり、処理の流れを把握しやすくなります。

3. クラスの活用 (応用)
より高度な方法として、クラスを使ってボタンオブジェクトを定義することもできます。
クラスを使うことで、ボタンのプロパティやメソッドをまとめて管理でき、コードの再利用性が高まります。

' クラスモジュール (ButtonClass)
Public name As String
Public text As String
Public action As String
Public position As String

Public Sub Create()
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 60, 60, 60, 60)
.Fill.ForeColor.RGB = RGB(220, 220, 220)
.Line.ForeColor.RGB = RGB(220, 220, 220)
.Name = name
With .TextFrame.Characters
.Text = text
.Font.Size = 16
End With
.Top = Range(position).Top
.Left = Range(position).Left
End With

ActiveSheet.Shapes(name).OnAction = action
End Sub

' 標準モジュール
Sub sample()
Dim button1 As ButtonClass
Set button1 = New ButtonClass
button1.name = "あいうえお"
button1.text = "不要行削除"
button1.action = "copy"
button1.position = "d1"
button1.Create

Dim button2 As ButtonClass
Set button2 = New ButtonClass
button2.name = "かきこ"
button2.text = "重複"
button2.action = "かきくけこ"
button2.position = "h1"
button2.Create
End Sub
このコードでは、ButtonClassというクラスを作成し、ボタンの情報をプロパティとして定義しています。
Createメソッドでボタンの作成処理を行い、sampleマクロでクラスのインスタンスを作成してボタンを生成しています。

これらの方法を組み合わせることで、より効率的で保守性の高いマクロを作成することができます。

No.1 回答者： いんちょ 回答日時： 2025/01/28 09:00

同じ処理をプロシジャー化すれば記述量は減ります。

この回答へのお礼

アドバイスありがとうございます

お礼日時：2025/02/08 09:03