Help with inserting photo to display

[ABabeNChrist]

I use this code to insert photos at desired target locations. The code works good but I have to tab out of the cell in order for the view the photo. For new users it may appear that the photo was not inserted. Is there a way to adjust the code to display photo after insertedI

Code: Select all

    Select Case Target.Column
        ' Check for columns L, P or S
    Case 2, 12, 17
        Select Case Target.Row
            ' Check for rows 14, 19, ..., 323
        Case 14, 15, 19, 20, 25, 26, 34, 35, 41, 42, 48, 49, 54, 55, 60, 61, 65, 66, 75, 76, 81, 82, 86, 87, 99, 100, _
             106, 107, 111, 112, 123, 124, 134, 135, 145, 146, 156, 157, 162, 163, 167, 168, 180, 181, 187, 188, 197, 198, _
             206, 207, 212, 213, 219, 220, 225, 226, 230, 231, 235, 236, 241, 242, 246, 247, 251, 252, 256, 257, 262, 263, _
             267, 268, 272, 273, 278, 279, 294, 295, 300, 301, 307, 308, 314, 315, 321, 322, 329, 330
            ' Target is the cell being double-clicked
            'This will insert photos into merged cells
            
            Dim Pic As Excel.Picture
            Dim PicLocation As String
            Dim MyRange As Range

        PicLocation = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")

        If PicLocation = "False" Then Exit Sub

        Set Pic = Me.Pictures.Insert(PicLocation)

        Const Adjustment = 2
        With Pic.ShapeRange
            .Left = Target.Left + Adjustment
            .Top = Target.Top + Adjustment
            .LockAspectRatio = msoFalse
            .ZOrder msoBringForward
            If .Width > .Height Then
                .Width = Target.Width
                If .Height > Target.Height Then .Height = Target.Height
            Else
                .Height = Target.Height
                If .Width > Target.Width Then .Width = Target.Width
            End If
            .Height = .Height - Adjustment - 40
            .Width = .Width - 2 * Adjustment
        End With

        With Pic
            .Placement = xlMoveAndSize
            .PrintObject = True
        End With

[HansV]

Insert the following line immediately above the first End Select:

Code: Select all

        Cancel = True

[ABabeNChrist]

Thank you Hans

[HansV]

That line must have been in (previous versions of) the code before...

[ABabeNChrist]

I believe that is correct