Problems hiding and showing images in Excel

[riddles70]

Hi

I need to be able to vary the logo at the top of a format I am preparing in Excel. Sometime it will be company A sometimes Company B etc etc

You cannot place an image in a cell, so I wondered if there was some way of creating a dropdown list that would call hidden images and make them visible

thanks

 

[byundt]

riddles70,
Here is a Worksheet_Change sub that will toggle between two different pictures depending on the selection in a dropdown. You'll need to do some editing to the sub to specify the cell location, desired size of your pictures and file paths. This sub goes in the code pane for the worksheet.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, targ As Range
Dim shp As Shape
Dim PicFile As String
Dim SizePointX As Long, SizePointY As Long

'Pick one of the next three statements to define location of your dropdowns
Set targ = [A1]
'Set targ = [A1:A5]
'Set targ = Union([A1:A5], [A10:A15])
Set targ = Intersect(targ, Target)
If targ Is Nothing Then Exit Sub

SizePointX = 25    'Desired width of picture in points
SizePointY = 25    'Desired height of picture in points
For Each cel In targ
    Select Case cel     'Put in paths to your pictures
    Case "Smiley face"
        PicFile = "C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\Sunset.jpg"
    Case "Sad face"
        PicFile = "C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\Winter.jpg"
    End Select
   
    With cel.Offset(0, 2)       'Put picture in cell two columns to right of dropdown
        For Each shp In .Parent.Shapes  'Delete existing pictures
            If shp.Type <> 8 Then   'Don't delete if shp.Type=8   That is the dropdown
                If shp.TopLeftCell.Address = .Address Then shp.Delete
            End If
        Next
        .Parent.Shapes.AddPicture PicFile, True, True, .Left, .Top, SizePointX, SizePointY
    End With
Next
End Sub

To install a sub in the code pane for a worksheet:
1) Right-click the sheet tab for the worksheet
2) Choose View Code from the resulting pop-up
3) Paste the suggested code in the resulting module sheet
4) ALT + F11 to return to the worksheet

If the above procedure doesn't work, then you need to change your macro security setting. To do so, open the Tools...Macro...Security menu item. Choose Medium, then click OK.

Cheers!

Brad

 

[riddles70]

Thanks for this reply. Actually this is more or less what we already have. But we do not want to be dependent on local file structures, so the excel sheets can be used independently regardless of machine or location.

We are looking to solve this with a series of show / hide images.

ANy ideas:-S? Thanks again

 

[byundt]

I have also put graphics on a hidden worksheet, then used the CopyPicture method to copy and paste them. The following sub could be called from a WorksheetChange sub (like my previous code) or run as a stand-alone macro.

Sub PasteGraphics()
Dim picGraphic
Dim shp As Shape
Dim picSite As Range

Set picSite = ActiveCell.Offset(0, 2)   'The graphic will be pasted here

Select Case ActiveCell.Value
Case "Smiley face"
    Set picGraphic = Worksheets("Graphics").Shapes("Smiley face")   'A named image on the Graphics worksheet
Case "Sad face"
    Set picGraphic = Worksheets("Graphics").Shapes("Sad face")
End Select
   
For Each shp In ActiveSheet.Shapes   'Find and delete the existing equation box & schematic
    Select Case shp.Type
    Case 11, 13     'You may need to add other numbers to this case to cover your graphic type
        If shp.TopLeftCell.Address = picSite.Address Then shp.Delete
    Case Else   'Don't delete drop-down lists or other shape objects
    End Select
Next

picGraphic.CopyPicture                      'Copy new schematic
picSite.PasteSpecial        'Paste it on the active sheet
Application.CutCopyMode = False
End Sub

Brad

 

[riddles70]

Brad

This looks super. So basically I have a hidden worksheet with a number of graphics which can be called into view on the active worksheet via a selection made by the user.

I am newish to excel....is there any possibility you could walk me through this a little:-s

I just need a few indications as to the steps I need to take......

Thanks so much

 

[byundt]

Put all of the following code in the code pane for the worksheet with the dropdowns. You can expand the Select Case in the PasteGraphics sub as much as you like. If the names of the graphic images are exactly the same as the dropdown, then you can eliminate the Select Case and assign the image directly (see the statement I commented out). Or you could use a VLOOKUP function if you have a table linking the values in the dropdown with the names of your graphic images.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, targ As Range
Dim shp As Shape
Dim PicFile As String
Dim SizePointX As Long, SizePointY As Long

'Pick one of the next three statements to define location of your dropdowns
Set targ = [A1]
'Set targ = [A1:A5]
'Set targ = Union([A1:A5], [A10:A15])
Set targ = Intersect(targ, Target)
If targ Is Nothing Then Exit Sub

For Each cel In targ
    PasteGraphics cel
Next
End Sub

Sub PasteGraphics(cel As Range)
Dim picGraphic
Dim shp As Shape
Dim picSite As Range

Set picSite = cel.Offset(0, 2)   'The graphic will be pasted here

'Set picGraphic=Worksheets("Graphics").Shapes(cel.Value)    'Alternative way of linking the graphic to the dropdown

Select Case cel.Value
Case "Smiley face"
    Set picGraphic = Worksheets("Graphics").Shapes("Smiley face")   'A named image on the Graphics worksheet
Case "Sad face"
    Set picGraphic = Worksheets("Graphics").Shapes("Sad face")
Case "Blue eyes"
    Set picGraphic = Worksheets("Graphics").Shapes("Old Blue eyes") 'The name of the shape doesn't need to be the same as the dropdown value
Case "frown"
    Set picGraphic = Worksheets("Graphics").Shapes("frown")
Case Else
    Set picGraphic = Worksheets("Graphics").Shapes("Default picture")
End Select
   
For Each shp In ActiveSheet.Shapes   'Find and delete the existing equation box & schematic
    Select Case shp.Type
    Case 11, 13     'You may need to add other numbers to this case to cover your graphic type
        If shp.TopLeftCell.Address = picSite.Address Then shp.Delete
    Case Else   'Don't delete drop-down lists or other shape objects
    End Select
Next

picGraphic.CopyPicture                      'Copy new schematic
picSite.PasteSpecial        'Paste it on the active sheet
Application.CutCopyMode = False
End Sub

To install a sub in the code pane for a worksheet:
1) Right-click the sheet tab for the worksheet
2) Choose View Code from the resulting pop-up
3) Paste the suggested code in the resulting module sheet
4) ALT + F11 to return to the worksheet

If the above procedure doesn't work, then you need to change your macro security setting. To do so, open the Tools...Macro...Security menu item. Choose Medium, then click OK.

Brad

 

[riddles70]

Great.....Thank you again

Here is what I have done

Using two worksheets

1. Worksheet 1 - code pasted in.
2. Worksheet 2 Renamed "Graphics" Contins two graphics with the names autoforma 1 and autoforma 2

3. Put a list on "Graphics" page, I call the list "Logos"
Autoforma 1
Autoforma 2

4. On Worksheet 1 I made a dropdown list from the data. Which I put in A2 I also changed the names in the cases to the appropriate ones.

Now I dont know for example, in which cell will be pasted the graphic "cel.Offset(0, 2)" Can I put a cell value here?

Also I dont know how to link the select list to the code. A vLookup is what i need? Where do I put it ?

Sorry, I guess I am not doing too well. I really appreciate the help. It is really all I have to do, I have no other tasks with Excel

Thanks

 

[byundt]

You can specify a cell directly instead of using cel.Offset(0,2). I used the Offset in case you had more than one cell with a dropdown.

Set picSite = [B15]   'The graphic will be pasted here

With only two choices, I suggest using the Select Case construction. The Case is what you see in the dropdown. The statement following it must use the exact name of the graphic object on the Graphics worksheet.

Did you know that you can change the name of a graphics object? To do this:
1) Click on the graphic object to select it
2) Notice its name in the address bar, a horizontal white rectangle above the intersection of row and column headers
3) If you don't like the name, click in the address bar, type in a new name, then hit Enter

Depending how well you do with my instructions, it may be helpful for you to post a link to your file. Many ISP allow their customers to create a personal web page. If so, you can post your file there, and then put the link in a Comment. This is the approach that I take.

You can post your file for free at Geocities:

http://geocities.yahoo.com/ps/learn2/HowItWorks4_Free.html

Another popular free site is AngelFire

http://www.angelfire.lycos.com/doc/subscriptions/index.html

Google is also trying to encourage people to post files with them.

http://base.google.com/base/default

If you don't want to sign up for one of the above services, then RapidUpload.com provides a free service at

http://www.rapidupload.com/

If none of the above work out for you, I would be willing to post a link to your file if you e-mail it to me. My address is at the bottom of this bio sketch:

http://www.experts-exchange.com/M_1064321.html

Brad

 

[riddles70]

Great.

I had changed the names of the files. I put the cell position. But no image is being pasted in the WOrksheet 1

Something is missing:-(

Maybe you could have a quick look.

http://www.totallypainfree.com/tmp/Libro1.xls

I have probably done something wrong:-( But looking forward to getting it right

 

[byundt]

That link is not working. Could you try again?

Brad

 

[riddles70]

Sorry I stuck it in a zip, some problem from the network here.

http://www.totallypainfree.com/tmp/Libro1.zip

 

[byundt]

I added a couple of statements to the Worksheet_Change sub so it wouldn't leave the picture selected. And I noticed that the names of the autoshape objects weren't the same as you had specified. When I changed it, the pictures appeared as expected.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, celDest As Range, targ As Range
Dim shp As Shape
Dim PicFile As String
Dim SizePointX As Long, SizePointY As Long

'Pick one of the next three statements to define location of your dropdowns
Set targ = [A1]
'Set targ = [A1:A5]
'Set targ = Union([A1:A5], [A10:A15])
Set targ = Intersect(targ, Target)
If targ Is Nothing Then Exit Sub

Set celDest = ActiveCell
For Each cel In targ
    PasteGraphics cel
Next
celDest.Select      'This statement unselects the graphic
End Sub

Sub PasteGraphics(cel As Range)
Dim picGraphic
Dim shp As Shape
Dim picSite As Range

Set picSite = [B7]   'The graphic will be pasted here

'Set picGraphic=Worksheets("Graphics").Shapes(cel.Value)    'Alternative way of linking the graphic to the dropdown

Select Case cel.Value
Case "Autoforma 1"
    Set picGraphic = Worksheets("Graphics").Shapes("AutoShape 1")   'A named image on the Graphics worksheet
Case "Autoforma 2"
    Set picGraphic = Worksheets("Graphics").Shapes("AutoShape 2")

Case Else
    Set picGraphic = Worksheets("Graphics").Shapes("AutoShape 1")
End Select
   
For Each shp In ActiveSheet.Shapes   'Find and delete the existing equation box & schematic
    Select Case shp.Type
    Case 11, 13     'You may need to add other numbers to this case to cover your graphic type
        If shp.TopLeftCell.Address = picSite.Address Then shp.Delete
    Case Else   'Don't delete drop-down lists or other shape objects
    End Select
Next

picGraphic.CopyPicture                      'Copy new schematic
picSite.PasteSpecial        'Paste it on the active sheet
End Sub

Brad

 

[riddles70]

Beautiful. Thank you so much. now I can make my worksheet. Thanks enormously

 

[riddles70]

Just opne tiny detail more. How do I hide the dropdownlist cell from the print view?

Thanks:-S

 

[byundt]

Here is some code that will turn the font color white when the workbook is being printed, then restore it. This code must go in the ThisWorkbook code pane.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Worksheets("PicSite").[A1].Font.ColorIndex = 2      'White font color
Application.OnTime Now, "ThisWorkbook.RestoreDropdown"
End Sub

Sub RestoreDropdown()
Worksheets("PicSite").[A1].Font.ColorIndex = xlColorIndexAutomatic
End Sub

To install a sub in the code pane for ThisWorkbook:
1) ALT + F11 to open the VBA Editor
2) If you don't see a list of VBA projects on the left, then CTRL + R to open the Project Explorer
3) In the Project Explorer window, double-click ThisWorkbook to open its code pane
4) Paste the suggested code in the resulting module sheet
5) ALT + F11 to return to the spreadsheet

Brad

 

[riddles70]

Works like a treat