エクセル VBAについて

エクセルにて、"□"または"■"の入力された未結合のセルをダブルクリックした時には"□"↔"■"の切り替え、横10，縦1の結合セルをダブルクリックした時には写真の貼り付けをしたいのですが、下記式では"□"↔"■"の切り替えはできますが、写真の貼り付けができません。
元々別々で作成していたものですが、同じイベントを並べることができないため、どうにかして一つにまとめようとしてるのですが、手詰まってしまいました。

どうかご指導お願いいたします。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Target.Columns.Count = 1 Then End

Select Case Target.Value
Case "□": Target.Value = "■"
Case "■": Target.Value = "□"
Case Else: Exit Sub
End Select
Cancel = True


If Not Target.Columns.Count = 10 And Target.Rows.Count = 1 Then Exit Sub

Application.ScreenUpdating = False
SendKeys "C:\{ENTER}"

For Each c In Selection

Set cm = c.MergeArea
If c.Address = cm.Item(1).Address Then
If Application.Dialogs(xlDialogInsertPicture).Show = False Then Exit Sub
With Selection
ActiveSheet.Shapes(.Name).LockAspectRatio = msoFalse
.Left = cm.Left
.Top = cm.Top
.Height = cm.Height
.Width = cm.Width
.ShapeRange.Line.Visible = msoTrue
.ShapeRange.Line.Weight = 1.25
.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
.Placement = xlFreeFloating
End With
End If
Next
Set cm = Nothing

End Sub

No.2 ベストアンサー 回答者： Qchan1962 回答日時： 2022/05/16 18:19

＃１

ざっくりで回答してしまいましたが、
確認するとFor Each C In Selectionなども不要かな？

結合セル部分

If Not Target.Columns.Count = 10 And Target.Rows.Count = 1 Then Exit Sub
Set cm = Selection(1).MergeArea
If Application.Dialogs(xlDialogInsertPicture).Show = False Then Exit Sub
Application.ScreenUpdating = False
With Selection
ActiveSheet.Shapes(.Name).LockAspectRatio = msoFalse
.Left = cm.Left
.Top = cm.Top
.Height = cm.Height
.Width = cm.Width
.ShapeRange.Line.Visible = msoTrue
.ShapeRange.Line.Weight = 1.25
.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
.Placement = xlFreeFloating
End With
Application.ScreenUpdating = True
Set cm = Nothing

ダメかな？

この回答へのお礼

何度も修正ありがとうございます。
こちらも無事に作動してくれました。

周りでコードを組める人がおらず、仕事の隙間時間に色々なサンプルコードを組み合わせて作っていたもので、正直なところ命令の内容が把握しきず、要不要がわからないまま作成してました。

今回の手詰まりで、きちんと内容を理解する事が大事だと実感しました。
何度も質問をしないよう、勉強を頑張りたいと思います。

本当にありがとうございました。

お礼日時：2022/05/17 09:21

No.1 回答者： Qchan1962 回答日時： 2022/05/16 18:05

こんにちは

添削するとこんな感じかな？

If Target.Count = 1 Then
Select Case Target.Value
Case "□": Target.Value = "■"
Case "■": Target.Value = "□"
Case Else: Exit Sub
End Select
Cancel = True
End If

If Not Target.Columns.Count = 10 And Target.Rows.Count = 1 Then Exit Sub
Application.ScreenUpdating = False
SendKeys "C:\{ENTER}"
For Each C In Selection
Set cm = C.MergeArea
If C.Address = cm.Item(1).Address Then
If Application.Dialogs(xlDialogInsertPicture).Show = False Then Exit Sub
With Selection
ActiveSheet.Shapes(.Name).LockAspectRatio = msoFalse
.Left = cm.Left
.Top = cm.Top
.Height = cm.Height
.Width = cm.Width
.ShapeRange.Line.Visible = msoTrue
.ShapeRange.Line.Weight = 1.25
.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
.Placement = xlFreeFloating
End With
End If
Next
Set cm = Nothing

変数は宣言したほうが良いかも・・・
Application.ScreenUpdating　はさほど強い命令では無いのですが
処理後、Trueを設定した方が良いと思います。

SendKeysは不要なのでは？

この回答へのお礼

早速の御指導、有難うございます。
修正いただいたコードで想定通りに動いてくれました。

お礼日時：2022/05/17 09:13