change colour of picture based on cell value

mickyflash

Board Regular
Joined
Jan 29, 2009
Messages
66
hello again guys

I have found this video of Bills that explains how I could dynamically change the .width & .Height of a shape in excel, but I am struggling to convert this to the shapes colour?

There would be only 2 options, if the linked cell is = to TRUE to view the picture In colour, or greyscale if FALSE

Thanks in advance for your help
 

Some videos you may like

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,088
Office Version
365
Platform
Windows
Below is code to toggle image between colour and greyscale, but further information required to answer your specific query
VBA Code:
Sub Toggle()
    Const G = msoPictureGrayscale
    Const A = msoPictureAutomatic
    With ActiveSheet.Shapes("Picture 999").PictureFormat
        If .ColorType = G Then .ColorType = A Else .ColorType = G
    End With

End Sub

Are you referring to a shape like a rectange or an image ?
How is the image lined to a cell ?
 

mickyflash

Board Regular
Joined
Jan 29, 2009
Messages
66
Hi Yongle

I have this code that deletes any images on the worksheet and then takes the url address in A2 and displays the image from the address 4 columns to the left.
I will have about 50 images on the worksheet all, taken via this method. ( I was planning on adding this code for each cell with a hyperlink, unless there is an easier way)

if the value in B2 = FALSE I would like the picture to return in greyscale

here is an example of one of the links http://premierleague-static-files.s3.amazonaws.com/premierleague/photos/players/110x140/p169187.png

VBA Code:
Public Sub Add_Images_To_Cells()

ActiveSheet.Pictures.DELETE

    Dim lastRow As Long
    Dim URLs As Range, URL As Range
    
    With ActiveSheet
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        Set URLs = .Range("A2")
    End With

    For Each URL In URLs
        URL.Offset(0, 4).Select
        URL.Parent.Pictures.Insert URL.Value
        DoEvents
    Next
    
End Sub
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,088
Office Version
365
Platform
Windows
Immediately below this line:
URL.Parent.Pictures.Insert URL.Value

Insert
VBA Code:
        With URL.Parent.Shapes(URL.Parent.Shapes.Count).PictureFormat
            If Not URL.Offset(, 1) Then .ColorType = 2
        End With

NB - this assumes values in column B are boolean TRUE / FALSE ( not text "TRUE" / "FALSE" )
 

mickyflash

Board Regular
Joined
Jan 29, 2009
Messages
66
Thanks @Yongle , but I am getting this error message with that code

Capture.PNG
Capture2.PNG
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,088
Office Version
365
Platform
Windows
Is there a picture in the sheet when the code fails ?
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,088
Office Version
365
Platform
Windows
(untested)
Something else you could try based on your original code

Replace this line
VBA Code:
        URL.Parent.Pictures.Insert URL.Value
with this
Code:
        With URL.Parent.Pictures.Insert(URL.Value)
            If Not URL.Offset(, 1) Then .PictureFormat.ColorType = 2
        End With
 

mickyflash

Board Regular
Joined
Jan 29, 2009
Messages
66
Thanks for your help, There is no picture using the first solution you suggested,

the second also gives me a debug error:
Capture.PNG
Capture2.PNG


although there is a picture on the worksheet, always in colour
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,088
Office Version
365
Platform
Windows
Try this then

Replace
VBA Code:
        With URL.Parent.Pictures.Insert(URL.Value)
            If Not URL.Offset(, 1) Then .PictureFormat.ColorType = 2
        End With
With
Code:
Dim Pic as Shape   '(this line could be placed at top of module with other declarations)

Set Pic = URL.Parent.Pictures.Insert(URL.Value)
If Not URL.Offset(, 1) Then Pic.PictureFormat.ColorType = 2
 

mickyflash

Board Regular
Joined
Jan 29, 2009
Messages
66
This gives me a type mis-match error on this line

VBA Code:
Set Pic = URL.Parent.Pictures.Insert(URL.Value)
 

Watch MrExcel Video

Forum statistics

Threads
1,100,063
Messages
5,472,237
Members
406,809
Latest member
haf19

This Week's Hot Topics

Top