エクセルマクロについて教えてください。 https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q13261610088 にて、質問させていただき本当に優しいカテゴリーマスターの方にマクロ文を作成していただきました。 動作は問題ありません。さらに欲が出てしまい・・・ 現在は9:14の結合セルにてイベントが発生する仕組みになっているようです。 これを「9:14」と「5:14」と「4:7」の結合セルでもイベントが発生するようにはどのようにすればよろしいでしょうか?ご教授ください。 追伸:もし、簡単にRGB(217、217,217)にて塗りつぶしてるセルのダブルクリックでイベント発生というのもできるのでしょうか? ↓↓マクロ文↓↓ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim shp As Variant, mypic As Variant, myRange As Range If (Target.Columns.Count <> 9 Or Target.Rows.Count <> 14) Then Exit Sub If (Application.ClipboardFormats(1) <> xlClipboardFormatPICT) And (Application.ClipboardFormats(1) <> xlClipboardFormatBitmap) Then MsgBox "クリップボードは空です。貼り付け画像を読み込みますか?" mypic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") If VarType(mypic) = vbBoolean Then Exit Sub If FileLen(mypic) > 3000000 Then MsgBox "ファイルサイズが大きくなってしまうので処理を中止しました。" _ & vbCrLf & "画像編集ソフト等にてサイズを落としてからもう一度作業してください。", vbCritical, "挿入エラー!!!" Exit Sub End If Set myRange = Target With Target Set shp = ActiveSheet.Shapes.AddPicture(mypic, _ LinkToFile:=False, SaveWithDocument:=True, Left:=.Left, Top:=.Top, Width:=0, Height:=0) shp.ScaleHeight 1, True shp.ScaleWidth 1, True End With Else ActiveSheet.Paste Set shp = Selection.ShapeRange End If Cancel = True shp.Left = Target.Left shp.Top = Target.Top Dim rX As Double, rY As Double With shp .LockAspectRatio = True rX = Target.Width / .Width rY = Target.Height / .Height If rX > rY Then .Height = .Height * rY * 0.95 Else .Width = .Width * rX * 0.95 End If .Left = .Left + (Target.Width - .Width) / 2 .Top = .Top + (Target.Height - .Height) / 2 Cancel = True End With End Sub
Visual Basic