Conditional formatting on autoshapes

  • Thread starter Thread starter Freshman
  • Start date Start date
F

Freshman

Dear experts,

Jacob Skaria, MVP wrote me a marco below for the solution of conditional
formatting on autoshapes. As Jacob's macro refers the value of A1 to the
default name of the autoshapes, such as: the value of A1 = 2, then the
autoshape named "Oval 2" will be changed to colour green. However, I want the
value of A1 refers to the text inside Oval 2 instead, such as: value A1 =
table and the text inside Oval 2 = table, then autoshpae Oval 2 will turn
into colour green. How can I get it done? Please kindly advise.

Thanks in advance.

QUOTE

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Shape, intCount As Integer
If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
For intCount = 1 To 10
On Error Resume Next
Set sh = ActiveSheet.Shapes("Oval " & intCount)
If Not sh Is Nothing Then
With sh
..Fill.Visible = msoTrue
..Fill.Solid
..Fill.ForeColor.SchemeColor = IIf(intCount = Target, 17, 1)
End With
ActiveSheet.DrawingObjects("Oval " & intCount).Text = "Hi" & intCount
ActiveSheet.DrawingObjects("Oval " & intCount).Font.ColorIndex = _
IIf(intCount = Target, 2, xlAutomatic)
ActiveSheet.DrawingObjects("Oval " & intCount).Font.Bold = (intCount =
Target)
End If
Set sh = Nothing
Next
End If
End Sub

UNQUOTE
 
Freshman,

You can loop through the shapes looking for the text: this version will only show the fill of the
shape with the matching text,

Private Sub Worksheet_Change(ByVal target As Range)
Dim sh As Shape

If target.Address <> "$A$1" Then Exit Sub

For Each sh In ActiveSheet.Shapes
If sh.TextFrame.Characters.Text = target.Value Then
With sh
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 17
End With
Else
sh.Fill.Visible = msoFalse
End If
Next sh

End Sub



HTH,
Bernie
MS Excel MVP
 
Hi again

In the first place I am not an MVP; but just another contributor.

Try the below...which will look out for any shapes and if the text matches
will format as required.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Shape, intComp As Integer
If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
For Each sh In ActiveSheet.Shapes
intComp = StrComp(sh.TextFrame.Characters.Text, Target.Text, vbTextCompare)
With sh
..TextFrame.Characters.Font.Bold = (intComp = 0)
..TextFrame.Characters.Font.ColorIndex = IIf(intComp, xlAutomatic, 2)
..Fill.ForeColor.SchemeColor = IIf(intComp, 1, 17)
End With
Next
End If
End Sub


If this post helps click Yes
 
Hi Bernie,

Thanks for your tips. What about if I input numbers into the autoshapes
instead of text. How you change the macro? Please kindly advise.

Thanks a million.
 
The autoshapes always have text. You could try this - change

If sh.TextFrame.Characters.Text = target.Value Then

to

If sh.TextFrame.Characters.Text = CStr(target.Value) Then

You could also format your target cell as string.

HTH,
Bernie
MS Excel MVP
 
Hi Bernie,

Sorry to bother you. I found a dialogue box "Runtime error 13, Type
mismatch" even I change the macro statement you teach me. Is there a way to
correct?

Thanks in advance.
 
Freshman,

I cannot get that error. What is the format of cell A1, and what value or text are you using?
Could you also post all of your code - perhaps that is the source of the error.

HTH,
Bernie
MS Excel MVP
 
Hi Bernie,

The code below is exactly the same (I just copy and paste) you wrote me
before. The format in A1, no matter I set it as "General", "Number" or
"Text", the same error message appeared.

Sorry to bother you. Thanks.

Private Sub Worksheet_Change(ByVal target As Range)
Dim sh As Shape

If target.Address <> "$A$1" Then Exit Sub

For Each sh In ActiveSheet.Shapes
If sh.TextFrame.Characters.Text = target.Value Then
With sh
..Fill.Visible = msoTrue
..Fill.Solid
..Fill.ForeColor.SchemeColor = 17
End With
Else
sh.Fill.Visible = msoFalse
End If
Next sh

End Sub
 
Hi Bernie,

Forget to write what the text I put inside the auotshpaes. It is simply the
numbers, such as 1, 2, 5, 60, 72 etc. I want if I input 1 into A1, then the
autoshape contains the text "1" will turn to green colour.

Thanks.
 
Freshman,

Contact me privately - make the obvious changes to my email address when you reply - and I will send
you a working version.

HTH,
Bernie
MS Excel MVP
 
Hi Bernie,

Can you give me your email address so that I can send the file to you? Many
thanks.
 
Back
Top