PDA

View Full Version : [SOLVED] Auto shape color change



Juriemagic
10-16-2015, 05:45 AM
Hi good people!,

I found this code:
Dim shp As Shape, r As Long, g As Long, b As Long

With Sheet1
For Each shp In .Shapes
With shp.TextFrame
Select Case .Characters.Text
Case "1"
r = 255
g = 0
b = 0
Case "2"
r = 0
g = 255
b = 0
End Select
End With
shp.Fill.ForeColor.RGB = RGB(r, g, b)
Next shp
End With



I have implemented this code in two sheets. It works perfectly in sheet3, but errors in sheet6..Would someone please be so kind to check why this is so?...Thank you all kindly..

Paul_Hossler
10-16-2015, 06:45 AM
Spin buttons and scrollbars and charts don't have a textframe with characters

You could add error handling (e.g. On Error Resume Next) or catch the shape type (below)



Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim shp As Shape, r As Long, g As Long, b As Long
With Sheet6
For Each shp In .Shapes
If shp.Type = msoOLEControlObject Then GoTo GetNextShape
If shp.Type = msoChart Then GoTo GetNextShape

With shp.TextFrame
Select Case .Characters.Text
Case "1"
r = 255
g = 0
b = 0
Case "2"
r = 0
g = 255
b = 0
End Select
End With

shp.Fill.ForeColor.RGB = RGB(r, g, b)

GetNextShape:
Next shp
End With
End Sub




PowerPoint has a .HasTextframe property which would be handy here I think

Juriemagic
10-16-2015, 07:15 AM
Hallo Paul_Hossler,

Thank you very much for this help. It wouldn't work using selection change or change, so I put it in a "Calculate" event. It really works great now, UNTILL I select the dropdown in O2...then everything is problematic again...Please my friend, could you kindly have a look at why this happens?...other than this, everything works great!..Thank you very much..

Paul_Hossler
10-16-2015, 08:29 AM
Need to add another line to catch that type of shape




Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim shp As Shape, r As Long, g As Long, b As Long
With Sheet6
For Each shp In .Shapes
If shp.Type = msoOLEControlObject Then GoTo GetNextShape
If shp.Type = msoChart Then GoTo GetNextShape
If shp.Type = msoFormControl Then GoTo GetNextShape ' <<<<<<<<<<

With shp.TextFrame
Select Case .Characters.Text
Case "1"
r = 255
g = 0
b = 0
Case "2"
r = 0
g = 255
b = 0
End Select
End With

shp.Fill.ForeColor.RGB = RGB(r, g, b)

GetNextShape:
Next shp
End With
End Sub

Juriemagic
10-18-2015, 11:08 PM
Super, thanx a million!!!..have a great day!!

Aflatoon
10-19-2015, 01:33 AM
It also looks as though you are only interested in processing the rectangles on that sheet, so you might use:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rect As Rectangle, r As Long, g As Long, b As Long


With Sheet6
For Each rect In .Rectangles
Select Case rect.Text
Case "1"
r = 255
g = 0
b = 0
Case "2"
r = 0
g = 255
b = 0
End Select
rect.Interior.Color = RGB(r, g, b)
Next rect
End With
End Sub

Juriemagic
10-19-2015, 01:51 AM
Yes Aflatoon, absolutely right, I did not mention that because I did not want to become a hassle, so I just left it, but I honestly appreciate you looking at this as well and actually taken the time to help me out. This is extremely kind of you. I am most certainly going to implement this extra coding...Thank you very much!

Just something if I may...would this change also prevent the Textbox to NOT format?, if not, is there a way to exclude the textbox as well?..

Aflatoon
10-19-2015, 02:07 AM
It will only process rectangles, not textboxes or anything else.

Juriemagic
10-19-2015, 02:16 AM
You have been a great help..Thank you Aflatoon..

Paul_Hossler
10-19-2015, 05:51 AM
Yes Aflatoon, absolutely right, I did not mention that because I did not want to become a hassle,..

Actually that would have made it easier and more robust as Aflatoon demonstrated

Always better to provide too much instead of not enough information

Juriemagic
10-19-2015, 06:04 AM
You're right Paul_Hossler, but it was ..to be honest, not a major matter, it was something I could live with, but since Aflatoon pointed that out, well, why not use it, it does look better. Thanx for your input...

Aflatoon
10-19-2015, 06:05 AM
Always better to provide too much instead of not enough information

Generally I agree but sometimes too much information leads to TLDR. ;)

Juriemagic
10-19-2015, 06:14 AM
:)

Paul_Hossler
10-19-2015, 06:19 AM
Generally I agree but sometimes too much information leads to TLDR. ;)

I had to look that up :rofl:

Juriemagic
10-19-2015, 06:34 AM
Haha..I pretended to know, but I also looked that up...never to old to learn something, even if it's not VBA.. :laugh2: