change colour of picture based on cell value

mickyflash

Board Regular
Joined
Jan 29, 2009
Messages
63
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
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,261
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
63
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
4,261
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
63
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
4,261
Is there a picture in the sheet when the code fails ?
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,261
(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
63
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
4,261
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
63
This gives me a type mis-match error on this line

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

Forum statistics

Threads
1,078,253
Messages
5,339,105
Members
399,278
Latest member
randomNumberGenerator2211

Some videos you may like

This Week's Hot Topics

Top