Private Sub Worksheet_Calculate()
Dim oPic As Picture
Dim myCell As Range
Dim myRng As Range

Me.Pictures.Visible = False

Set myRng = Me.Range("a1,a3")

For Each myCell In myRng.Cells
With myCell
For Each oPic In Me.Pictures
If oPic.Name = .Text Then
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
Exit For
End If
Next oPic
End With
Next myCell
End Sub

i currently has this macro.
is there a way to set all my picture size and fix it??

and when i copy everything to a new sheet, some picture seem to be gone.??
any idea what happen?

See if this works better. You picture names may not exactly match the name
in text in the cells. I think depending on how you copy the pictures the
picture names may change when you go from sheet to sheet. You can see the
picture names if you click on the picture and then look in the NAME BOX in
the tool bars at the top of the worksheet. It is usally to the left of the
F(x) box where you enter formulas. Compare the names of the picture in the
original sheet and the new sheet to see if they match.

Private Sub Worksheet_Calculate()
Dim oPic As Picture
Dim myCell As Range
Dim myRng As Range

Me.Pictures.Visible = False

Set myRng = Me.Range("a1,a3")

For Each myCell In myRng.Cells
With myCell
set oPic = me.pictures(.text)
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
Next oPic
End With
Next myCell
End Sub


"Oligo" wrote:

Private Sub Worksheet_Calculate()
Dim oPic As Picture
Dim myCell As Range
Dim myRng As Range

Me.Pictures.Visible = False

Set myRng = Me.Range("a1,a3")

For Each myCell In myRng.Cells
With myCell
For Each oPic In Me.Pictures
If oPic.Name = .Text Then
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
Exit For
End If
Next oPic
End With
Next myCell
End Sub

i currently has this macro.
is there a way to set all my picture size and fix it??

and when i copy everything to a new sheet, some picture seem to be gone.??
any idea what happen?