Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Conditional formatting on autoshapes

16 views
Skip to first unread message

Freshman

unread,
Nov 20, 2009, 12:38:01 AM11/20/09
to
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

@consumerdotorg Bernie Deitrick

unread,
Nov 20, 2009, 8:59:08 AM11/20/09
to
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


"Freshman" <Fres...@discussions.microsoft.com> wrote in message
news:2E6B6215-F8AE-4CAA...@microsoft.com...

Jacob Skaria

unread,
Nov 20, 2009, 9:25:01 AM11/20/09
to
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
---------------
Jacob Skaria

Freshman

unread,
Nov 22, 2009, 7:33:01 AM11/22/09
to
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.

"Bernie Deitrick" wrote:

> .
>

@consumerdotorg Bernie Deitrick

unread,
Nov 22, 2009, 2:50:09 PM11/22/09
to
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


"Freshman" <Fres...@discussions.microsoft.com> wrote in message

news:3033B15D-509F-40B0...@microsoft.com...

Freshman

unread,
Nov 22, 2009, 9:49:01 PM11/22/09
to
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.

"Bernie Deitrick" wrote:

> .
>

@consumerdotorg Bernie Deitrick

unread,
Nov 23, 2009, 11:21:39 AM11/23/09
to
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


"Freshman" <Fres...@discussions.microsoft.com> wrote in message

news:B7CDE307-273E-41E5...@microsoft.com...

Freshman

unread,
Nov 24, 2009, 4:48:01 AM11/24/09
to
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

"Bernie Deitrick" wrote:

> .
>

Freshman

unread,
Nov 24, 2009, 4:51:02 AM11/24/09
to
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.

"Bernie Deitrick" wrote:

> .
>

@consumerdotorg Bernie Deitrick

unread,
Nov 24, 2009, 9:25:10 AM11/24/09
to
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


"Freshman" <Fres...@discussions.microsoft.com> wrote in message

news:EC7E61EE-E393-4B45...@microsoft.com...

Freshman

unread,
Nov 25, 2009, 2:05:01 AM11/25/09
to
Hi Bernie,

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

"Bernie Deitrick" wrote:

> .
>

@consumerdotorg Bernie Deitrick

unread,
Nov 25, 2009, 8:23:22 AM11/25/09
to
deitbe @ consumer dot org


HTH,
Bernie
MS Excel MVP


"Freshman" <Fres...@discussions.microsoft.com> wrote in message

news:8E8E3861-9ED3-4073...@microsoft.com...

0 new messages