Hi all,
I've been playing around with a lot of code lately and this is the best that I have been able to do so far. I would really love hover over function instead but I'm not that good.
My problem is I can get the image inserted in to K1 but I have an activeX control in A1 and that gets deleted if I use this ActiveSheet.Pictures.Delete it deletes everything.
I can't remember the other thing I do but then it doesn't delete the picture in K1 just puts a new image over the top.
So finally I thought to do an If Statement but have completely buggered it up. Hoping someone could help me out.
I've been playing around with a lot of code lately and this is the best that I have been able to do so far. I would really love hover over function instead but I'm not that good.
My problem is I can get the image inserted in to K1 but I have an activeX control in A1 and that gets deleted if I use this ActiveSheet.Pictures.Delete it deletes everything.
I can't remember the other thing I do but then it doesn't delete the picture in K1 just puts a new image over the top.
So finally I thought to do an If Statement but have completely buggered it up. Hoping someone could help me out.
Code:
If ActiveSheet.Shapes.Range(Array("Picture *")).Count > 0 Then
ActiveSheet.Shapes.Range(Array("Picture *")).Delete
End If
VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim mypic As Picture
Dim PicLoc As String
If Target.Address = "$B$" & ActiveCell.Row Then
'ActiveSheet.Pictures.Delete
If ActiveSheet.Shapes.Range(Array("Picture *")).Count > 0 Then
ActiveSheet.Shapes.Range(Array("Picture *")).Delete
End If
PicLoc = "O:\2023\School Photos\2023\Students\" & ActiveCell.Value & ".jpg"
On Error Resume Next
Set mypic = ActiveSheet.Pictures.Insert(PicLoc)
On Error GoTo 0
If mypic Is Nothing Then
Range("K1").Value = "No Picture"
Else
With Range("K1")
.Value = ""
.RowHeight = mypic.Height
mypic.Top = .Top
mypic.Left = .Left
mypic.Placement = xlMoveAndSize
End With
End If
End If
End Sub
Last edited: