Hi again Eric,
I am not really sure what you don’t understand about inserting additional
pictures. You position them the same way that I have. I will try to explain
it all. Maybe you already know some and some you probably do not know.
Do you understand that Cells(10, "B") is the same as Range("B10").
The top position of the picture is the top position of cell B10
The left position of the picture is the left position of cell B10
The bottom of the picture is the bottom of cell B13 but we can’t find the
bottom position of a cell but we can find the top of the next cell B14 which
is the same as the bottom of B13.
Therefore we subtract the top of the cell B10 from the top of cell B14 to
get the height.
Similarly with the width. We subtract the left position of cell B10 from the
left position of cell D10 (left of D10 is same as right of C10).
You will note that I assigned the picture to an object variable when I
inserted it using the following code.
Set myPic = ActiveSheet.Pictures.Insert("C:\TempPic.JPG")
This is done so that we have a specific reference to the picture. With that
reference we can change its name from the default name of Picture X (where X
is a number.) You can do that with the following line of code.
myPic.Name = "PicAtB10"
You can use any name you like between the double quotes but don’t use names
like B10 on their own or it will become confused with cell references.
Now that the picture has a name, you can always refer to it by name. I have
amended your code to reference it by name when assigning to a variable for
deleting. That way you do not have to use Picture(1) which is the first
picture on the worksheet. When you delete Picture(1), the next picture on the
worksheet becomes Picture(1) but the name given to the picture will not
change. (Picture(1) is only an index number and is counted from the first
picture on the worksheet.)
Refer to the amended code below for info on how to insert additional pictures.
Previous images on the worksheet that you cannot remove will probably have
to be selected and deleted manually because you will not know their names to
reference them with code. (Note you could have pictures one on top of another
and deleting might appear not to work but just continue selecting and
deleting until image is gone.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myPic As Object
Dim dblTop As Double
Dim dblLeft As Double
Dim dblHeight As Double
Dim dblWidth As Double
If Target.Address = "$A$1" Then
On Error Resume Next
'Set myPic = ActiveSheet.Pictures(1) 'Delete this line
Set myPic = ActiveSheet.Shapes("PicAtB10")
On Error GoTo 0
If Not myPic Is Nothing Then myPic.Delete
'***********************************************
'Repeat the code betwen the asterisk lines for
'additional pictures
If Range("A1") = 1 Then
Set myPic = ActiveSheet.Pictures.Insert("C:\TempPic.JPG")
Else
Set myPic = ActiveSheet.Pictures.Insert("C:\TempPic2.JPG")
End If
myPic.Name = "PicAtB10"
'Set the variables for the picture
'top, left, height and width.
dblTop = Cells(10, "B").Top
dblLeft = Cells(10, "B").Left
dblHeight = Cells(14, "B").Top - Cells(10, "B").Top
dblWidth = Cells(10, "D").Left - Cells(10, "B").Left
With myPic
'next line is optional. See my previous post
'for what it does.
.ShapeRange.LockAspectRatio = msoFalse '/ msoTrue
.Top = dblTop
.Left = dblLeft
.Height = dblHeight
.Width = dblWidth
End With
'**********************************************
End If
End Sub
