click shape or button (preview/close) that displays an image

Question

I am new to VBA and seeking help on a work project. I have done some research and got started but am now over my head.

My objectives are: Create a click shape or butto

Answer 1

While your original code was actually working, I made a few slight adjustments to ensure that all (multiple) pictures are included / shown on the sheet and to align these picture below each other. Have a look at the comments in the code and let me know what you think:

Option Explicit

Sub Macro1()

Dim lngRow As Long
Dim strPath As String
Dim picItem As Picture
Dim shtPatient As Worksheet

'If there are multiple pictures then they should be shown
'  underneath each other. dblLeft and dblTop will be used
'  to place the next picture underneath the last one.
Dim dblTop As Double
Dim dblLeft As Double

Set shtPatient = ThisWorkbook.Worksheets(1)
strPath = "F:\CAD_CAM division\Unsorted Models\"

With shtPatient.Shapes("Rounded Rectangle 1").TextFrame2.TextRange.Characters
    If .Text = "Close" Then
        .Text = "Preview"
        ActiveSheet.Pictures.Delete
    Else
        .Text = "Close"
        For lngRow = 2 To shtPatient.Cells(shtPatient.Rows.Count, "A").End(xlUp).Row
            'First check if the file actually exists / can be found and inserted
            If Dir(strPath & shtPatient.Cells(lngRow, 1).Value2 & ".jpg") <> "" Then
                Set picItem = shtPatient.Pictures.Insert(strPath & shtPatient.Cells(lngRow, 1).Value2 & ".jpg")
                'Name the picture so it can be found afterwards again using VBA
                picItem.Name = shtPatient.Cells(lngRow, 1).Value2 & ".jpg"
                If lngRow = 2 Then
                    picItem.Top = shtPatient.Range("F2").Top
                    picItem.Left = shtPatient.Range("F2").Left
                    dblTop = picItem.Top + picItem.Height + 10
                    dblLeft = picItem.Left
                Else
                    picItem.Top = dblTop
                    picItem.Left = dblLeft
                    dblTop = picItem.Top + picItem.Height + 10
                End If
            End If
        Next lngRow
    End If
End With

End Sub