brucemc wrote:
I think I'm up a creek. Ain't no paddle. Never was. Never will be.

Hi Bruce,
So that you don't have to have a copy of every picture on every sheet,
you can have every picture on Sheet1 with code determining which one is
visible. The code can also copy the visible picture onto every other
sheet and delete the previous visible picture.

I've used a WorksheetChange event procedure and a standard procedure to
control the visibility of all the pictures. I renamed the pictures
MyPic001, MyPic002 and MyPic003. I have limited myself to 3 pictures,
but naming them this way gives enough room for 1000 pictures (MyPic000
to MyPic999).
I renamed the pictures this way...

1. Select a picture
2. Click in the Name box on the left side of the formula bar
3. Type required name eg MyPic003
4. Press Enter (I too often forget this step. Try not to forget it,
otherwise the picture's name will not change and it will be ignored by
the code)

After all the pictures have been renamed and positioned exactly where
you want them to appear on Sheet1 the ensuing code does the
following...

If you change the value in A1 on Sheet1 to say 3 then the picture named
MyPic003 will be visible on Sheet1 while all the other pictures with a
name of the form MyPicnnn will be invisible. The visible picture is
also copied and pasted into exactly the same position on all the other
sheets after the copied MyPicnnn from the previous Sheet1 A1 value has
been deleted (deleted by the standard procedure)

If you want to try it out on a copy of your workbook...
1. Copy the following code
2. Right click the Sheet1 tab then select "View Code" from the Popup
menu
3. Paste the code into the Sheet1 code module (Both can go there)


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
'$A$1 is the address of the cell whose value determines
'which picture is visible. Change to suit your needs.
'Error will occur if $s omitted
Application.ScreenUpdating = False
Dim NewPicHeight As Single
Dim NewPicWidth As Single
Dim NewPicLeft As Single
Dim NewPicTop As Single
Dim NewPicName As String
DeleteOldPic
Dim ncPics As New Collection
Dim Shp As Shape
Dim Sht As Worksheet
For Each Shp In Me.Shapes
If Left(Shp.Name, 5) = "MyPic" Then
ncPics.Add Item:=Shp
End If
Next Shp
For Each Shp In ncPics
If Right(Shp.Name, Len(Target.Value)) _
= CStr(Target.Value) Then
Shp.Visible = True
NewPicHeight = Shp.Height
NewPicWidth = Shp.Width
NewPicLeft = Shp.Left
NewPicTop = Shp.Top
Shp.Copy
NewPicName = Shp.Name
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name < Me.Name Then
With Sht
.Paste
.Activate
.Range("A1").Select
End With
Me.Activate
End If
Next Sht
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name < Me.Name Then
With Sht.Shapes(NewPicName)
.Height = NewPicHeight
.Width = NewPicWidth
.Top = NewPicTop
.Left = NewPicLeft
.Name = "OldPic"
End With
End If
Next Sht
Else: Shp.Visible = False
End If
Next Shp
End If
End Sub



Public Sub DeleteOldPic()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name < Worksheets(1).Name Then
On Error Resume Next
Sht.Shapes("OldPic").Delete
End If
Next Sht
End Sub

Hope this helps you with your canoe.

Ken Johnson