[[20170512145700]]　『指定したセルのみ、画像挿入したい』（もじょ）　ページの最後に飛ぶ

『指定したセルのみ、画像挿入したい』（もじょ）

以下のコードを使用することでセル内（結合含む）をダブルクリックすると比率維持した画像が挿入できました。
しかし、これだと全てのセルに適用されてしまい困っています。
例えばA1だけに適用させたいです。
どこにどのコードを入れれば良いか教えてほしいです。
ちなみにエクセルは素人で、マクロを使用したのは今回が初めてです。。。

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

    Dim myF As Variant
    Dim mySp As Object
    Dim myAD1 As String
    Dim myAD2 As String
    Dim myHH As Double
    Dim myWW As Double
    Dim myHH2 As Double
    Dim myWW2 As Double
    Cancel = True
    '===============画像選択
    myF = Application.GetOpenFilename _
           ("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False)
    If myF = False Then
        MsgBox "画像を選択してください(終了)"
        Exit Sub
    End If
    '===============画像の掃除
    For Each mySp In ActiveSheet.Shapes
        myAD1 = mySp.TopLeftCell.MergeArea.Address
        myAD2 = Target.Address
        If myAD1 = myAD2 Then mySp.Delete
    Next
    '===============画像の貼り付け
    Set mySp = ActiveSheet.Shapes.AddPicture(Filename:=myF, LinkToFile:=False, _
        SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, _
        Width:=0, Height:=0)    '★　とりあえず　縦横０で。

     '範囲内で最大になるように加工
    With mySp
        Set r = .TopLeftCell.MergeArea
        If r.Width / .Width < r.Height / .Height Then
            d = Application.WorksheetFunction.RoundDown(r.Width / .Width, 2)
        Else
            d = Application.WorksheetFunction.RoundDown(r.Height / .Height, 2)
        End If
        .ScaleWidth d, msoFalse, msoScaleFromTopLeft
        .ScaleHeight d, msoFalse, msoScaleFromTopLeft
        .Left = r.Left + r.Width / 2 - .Width / 2
        .Top = r.Top + r.Height / 2 - .Height / 2
    End With
    '===============タテヨコの縮尺を保持
    If mySp.Width > Target.Width Then mySp.Width = Target.Width
    If mySp.Height > Target.Height Then mySp.Height = Target.Height
    '===============中央へ調整
    myHH2 = (Target.Height / 2) - (mySp.Height / 2)
    myWW2 = (Target.Width / 2) - (mySp.Width / 2)
    mySp.Top = Target.Top + myHH2
    mySp.Left = Target.Left + myWW2
    Set mySp = Nothing
 End Sub

＜使用 Excel：Excel2007、使用 OS：Windows10 ＞

すみません、適当にやってたら解決しました。。。
（もじょ） 2017/05/12(金) 15:15

コメント返信：

[ 一覧(最新更新順) ]

[[20170512145700]] 『指定したセルのみ、画像挿入したい』（もじょ） ページの最後に飛ぶ

[[20170512145700]]　『指定したセルのみ、画像挿入したい』（もじょ）　ページの最後に飛ぶ