This used Forms-type command buttons because one macro can be assigned to all the buttons created. The one macro can determine which button called it using the Application.Caller method.
Private Sub PopUp_Pic()
Dim Btn As Button
Set Btn = ActiveSheet.Buttons(Application.Caller)
Application.ScreenUpdating = False
Delete_Popup_Pic
With ActiveSheet.Pictures.Insert(Btn.TopLeftCell.Offset(, 3).Value)
'Picture Centered on screen
.Left = ActiveWindow.VisibleRange(1).Left + (ActiveWindow.VisibleRange.Width / 2 - .Width / 2)
.Top = ActiveWindow.VisibleRange(1).Top + (ActiveWindow.VisibleRange.Height / 2 - .Height / 2)
.Name = "PopUpPic"
End With
Application.ScreenUpdating = True
End Sub
Sub Delete_Popup_Pic()
On Error Resume Next
ActiveSheet.Pictures("PopUpPic").Delete
End Sub
Sub Create_Buttons_and_Pics()
Dim cl As Range 'iterator
Application.ScreenUpdating = False
'For testing: delete old buttons and pics
' On Error Resume Next
' ActiveSheet.Buttons.Delete
' ActiveSheet.Pictures.Delete
' On Error GoTo 0
For Each cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
If Not IsEmpty(cl) And Not IsEmpty(cl.Offset(, 4)) Then
With ActiveSheet.Pictures.Insert(cl.Offset(, 4).Value)
.Left = cl.Offset(0, 5).Left
.Top = cl.Offset(0, 5).Top
.Width = cl.Offset(0, 5).Width
.Height = cl.Offset(0, 5).Height
End With
With ActiveSheet.Buttons.Add(Left:=cl.Offset(, 1).Left, _
Top:=cl.Offset(, 1).Top, _
Width:=cl.Offset(, 1).Width, _
Height:=cl.Offset(, 1).Height)
.Caption = cl.Value
.OnAction = "PopUp_Pic"
End With
End If
Next cl
Application.ScreenUpdating = True
End Sub
Bookmarks