How can I programatically change photos in one worksheet

S

Steve

I have a worksheet that displays the performance for a single retail
outlet. I change the location name and via lookups I change the data
in the worksheet to reflect the sale performance for the new location.

I would like to have a unique photo of each retail location when I
select a different location.

Is there any way to programmatically have a new photo automatically
display when a new location is selected?

Steve Sammons
[email protected]
 
S

Steve

Gord:

This is wonderful! However, when I paste the code into my worksheet and
begin putting it together I get a runtime error "Unable to set the
Visual property of the Picture class".

The debugger highlights the line that contains "Me.Pictures.Visible =
False"

Any thoughts?

Steve
 
G

Gord Dibben

Steve

Do you have pictures on the worksheet?

Have you got the lookup table on sheet2?

If you didn't download JE's example file you should do so to see how he has it
set up.

His workbook does as advertised.


Gord
 
S

Steve

I do have the lookup table on a sheet 2 and I do have the images on the
sheet that has the formula. If I asterisk out the "Me.Pictures.Visible
= False" it works. The only problem is that all the images are visible
and the order of the photos doesn't change. Everything works...I
just can't make all the images disappear. On this same sheet are
several other Graphs but I inserted a bunch of graphs into the sample
file and that didn't mess things up. I have removed all the photos and
put new ones in to see if there was an issue with the property of the
images. None of these tactics has led to success.

Any thoughts?

Steve
 
S

Steve

And I have downloaded JE file and it works fine. I also moved the two
sheets from his file over to the file that I am working on to see if it
would work there and it does. But my master sheet doesn't like the
hide pictures line at all.
 
S

Steve

This now is very weird. I copied the two sheets that are in my master
file off to a new document. My main document is 21 meg and this new
document has no data in it; just the format and graphs that don't link
anywhere. And now the routine works just fine. So there could be some
relationship to the size of the file. I am going to try it the other
way where I eliminate all the sheets and see if it begins to work.

Have you ever heard of anything like this?
 
G

Gord Dibben

Steve

Beats me<g>

JE may drop by and give some insight......hint, hint, nudge, nudge.


Gord

This now is very weird. I copied the two sheets that are in my master
file off to a new document. My main document is 21 meg and this new
document has no data in it; just the format and graphs that don't link
anywhere. And now the routine works just fine. So there could be some
relationship to the size of the file. I am going to try it the other
way where I eliminate all the sheets and see if it begins to work.

Have you ever heard of anything like this?

Gord Dibben MS Excel MVP
 
S

Steve

I will now close this because I figured out a work around.

Because the sheet failed when the code "me.pictures.visible = false"
was used here's the work around.

I turned all the photos off that didn't match and then turned on the
one that did. I also added an additional line to turn the company's
logo on.

It works...not perfect but it works. I have no clue why
"me.pictures.visible = false" makes it bomb but I thank you for the
help!!!!

Here's the Code:

Option Explicit

Private Sub Worksheet_Calculate()
Dim oPic As Picture
Application.ScreenUpdating = False
'Me.Pictures.Visible = False
With Range("N7")
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

For Each oPic In Me.Pictures
If oPic.Name <> .Text Then
oPic.Visible = False
oPic.Top = .Top
oPic.Left = .Left
Exit For
End If
Next oPic

End With

With Range("A2")
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

End Sub
 
K

Ken Johnson

Gord said:
Steve

Beats me<g>

JE may drop by and give some insight......hint, hint, nudge, nudge.


Gord



Gord Dibben MS Excel MVP


Hi Steve and Gord,

I've encountered a few other instances where projects using this code
have failed because of the same problem.
In each case, they have added the code and it works well, then they
have added more pictures to the sheet only to discover that a point is
reached when the code falls down at...

Me.Pictures.Visible = False

I'm guessing Steve hit the problem straight away because his
worksheet already had enough pictures to cause the problem when the
code was added.

I've been lucky enough to find a solution but I'm not smart enough
to figure out why the problem occurs in the first place.

My solution to the problem has been to avoid dimensioning the pictures
as Picture objects.
I have dimensioned them as Shape objects and then separated the
pictures from all of the other shapes using their Type property, which
is msoPicture or 13.

After making the above change, as far as I can tell, it is then no
longer possible to make all the pictures invisible in one fell swoop
the way that "Me.Pictures.Visible = False" does, so a loop must be
used in its place.

The following code should work for Steve after he either edits the code
so that it contains the name that Excel uses for his Logo or he changes
his logo's name (in the Name box on the left side of the Formula bar)
to "Logo"...

Private Sub Worksheet_Calculate()
Dim oPic As Shape
Application.ScreenUpdating = False
For Each oPic In Me.Shapes
If oPic.Type = 13 And oPic.Name <> "Logo" Then
oPic.Visible = False
End If
Next oPic
With Range("N7")
For Each oPic In Me.Shapes
If oPic.Name = .Text Then
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
Exit For
End If
Next oPic
End With
End Sub

Note that on his site JE adds the following warning...
"Note that for large numbers of pictures (like, say, a parts
catalog), a database solution would likely be much easier and much more
efficient."

Ken Johnson
 
K

Ken Johnson

Here's possibly a better solution, since it uses one loop instead of
two...

Private Sub Worksheet_Calculate()
Dim oPic As Shape
Application.ScreenUpdating = False
For Each oPic In Me.Shapes
Select Case oPic.Type
Case 13
Select Case oPic.Name
Case "Logo"
'Excludes logo from changes.
'NB either edit above line
'to match the name xl uses
'for your company logo
'OR change its xl name
'to "Logo" w/o quotes
Case Range("N7").Text
oPic.Visible = True
With Range("N7")
oPic.Top = .Top
oPic.Left = .Left
End With
Case Else
oPic.Visible = False
End Select
End Select
Next oPic
End Sub

Ken Johnson
 
Top