sksanjeev786
Well-known Member
- Joined
- Aug 5, 2020
- Messages
- 882
- Office Version
- 365
- 2016
- Platform
- Windows
Sub ShadeAndColor()
Dim Rng As Range, c As Range
Set Rng = Application.InputBox("Select a range", "Get User Range", Type:=8)
For Each c In Rng
If c.Value >= 5 Then
c.Interior.ColorIndex = 3
Else
c.BorderAround ColorIndex:=1
If c.Value <= -5 Then
c.BorderAround ColorIndex:=3
Else
c.BorderAround ColorIndex:=15
End If
End If
Next c
End Sub
This is as you requested but to me doesn't work well with the three border colour options
VBA Code:Sub ShadeAndColor() Dim Rng As Range, c As Range Set Rng = Application.InputBox("Select a range", "Get User Range", Type:=8) For Each c In Rng If c.Value >= 5 Then c.Interior.ColorIndex = 3 Else c.BorderAround ColorIndex:=1 If c.Value <= -5 Then c.BorderAround ColorIndex:=3 Else c.BorderAround ColorIndex:=15 End If End If Next c End Sub
Sub color_condtion()
With Range("B2:H15")
.FormatConditions.Delete
.FormatConditions.AddDatabar
.FormatConditions(.FormatConditions.Count).ShowValue = True
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1)
.MinPoint.Modify newtype = -5
.MaxPoint.Modify newtype = 5
End With
With .FormatConditions(1).BarColor
.Color = RGB(111, 111, 111)
.TintAndShade = 0
End With
.FormatConditions(1).BarFillType = xlDataBarFillGradient
.FormatConditions(1).Direction = xlContext
.FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
.FormatConditions(1).BarBorder.Type = xlDataBarBorderSolid
.FormatConditions(1).NegativeBarFormat.BorderColorType = _
xlDataBarColor
With .FormatConditions(1).BarBorder.Color
.Color = RGB(111, 111, 111)
.TintAndShade = 0
End With
.FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
With .FormatConditions(1).AxisColor
.Color = RGB(0, 0, 0)
.TintAndShade = 0
End With
With .FormatConditions(1).NegativeBarFormat.Color
.Color = RGB(255, 0, 0)
.TintAndShade = 0
End With
With .FormatConditions(1).NegativeBarFormat.BorderColor
.Color = RGB(255, 0, 0)
.TintAndShade = 0
End With
End With
End Sub
Book1 | ||||||||||
---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | |||
1 | ||||||||||
2 | I would recommend to my friends and family | -4 | 2 | -4 | -3 | -5 | -2 | |||
3 | Works better than other brands | |||||||||
4 | Improves the Lcok and feel of my skin | 5 | ||||||||
5 | Is a brand I trust | |||||||||
6 | Leaves skin feeling hydrated | |||||||||
7 | Is good value for tie money | -5 | 5 | |||||||
8 | Is a brand that shares my values | |||||||||
9 | Gcod for sensitive skin | 5 | 4 | -5 | ||||||
10 | Offers the most advanced formulas and technology | |||||||||
11 | Contains natural ingredients that really work | 4 | 2 | -3 | ||||||
12 | Helps heal and relieve skin issues | |||||||||
13 | Are clinicalty proven to work | -5 | ||||||||
14 | Is socially and environmentally responsible | |||||||||
15 | Is recommended by doctors and dermatobogists | |||||||||
Sheet2 |
Cells with Conditional Formatting | ||||
---|---|---|---|---|
Cell | Condition | Cell Format | Stop If True | |
B2:H15 | Other Type | DataBar | NO |
Hi
VBA Code:Sub color_condtion() With Range("B2:H15") .FormatConditions.Delete .FormatConditions.AddDatabar .FormatConditions(.FormatConditions.Count).ShowValue = True .FormatConditions(.FormatConditions.Count).SetFirstPriority With .FormatConditions(1) .MinPoint.Modify newtype = -5 .MaxPoint.Modify newtype = 5 End With With .FormatConditions(1).BarColor .Color = RGB(111, 111, 111) .TintAndShade = 0 End With .FormatConditions(1).BarFillType = xlDataBarFillGradient .FormatConditions(1).Direction = xlContext .FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor .FormatConditions(1).BarBorder.Type = xlDataBarBorderSolid .FormatConditions(1).NegativeBarFormat.BorderColorType = _ xlDataBarColor With .FormatConditions(1).BarBorder.Color .Color = RGB(111, 111, 111) .TintAndShade = 0 End With .FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic With .FormatConditions(1).AxisColor .Color = RGB(0, 0, 0) .TintAndShade = 0 End With With .FormatConditions(1).NegativeBarFormat.Color .Color = RGB(255, 0, 0) .TintAndShade = 0 End With With .FormatConditions(1).NegativeBarFormat.BorderColor .Color = RGB(255, 0, 0) .TintAndShade = 0 End With End With End Sub
Book1
A B C D E F G H 1 2 I would recommend to my friends and family -4 2 -4 -3 -5 -2 3 Works better than other brands 4 Improves the Lcok and feel of my skin 5 5 Is a brand I trust 6 Leaves skin feeling hydrated 7 Is good value for tie money -5 5 8 Is a brand that shares my values 9 Gcod for sensitive skin 5 4 -5 10 Offers the most advanced formulas and technology 11 Contains natural ingredients that really work 4 2 -3 12 Helps heal and relieve skin issues 13 Are clinicalty proven to work -5 14 Is socially and environmentally responsible 15 Is recommended by doctors and dermatobogists Sheet2
Cells with Conditional Formatting Cell Condition Cell Format Stop If True B2:H15 Other Type DataBar NO
I think your issue lies with VBA being in break mode rather than with any of the codes.
Rather than typing a out a lengthy how to that's already written, please see here to reset; What is the Error "Can't Execute Code in Break Mode"? - VBA and VB.Net Tutorials, Education and Programming Services
Also it looks like your using powerpoint. This is an excel based solution, not being familiar with ppt code, your mileage may vary with these codes.
Public Sub PPT_color_condtion()
Dim Shp As Shape
Dim Prst As Presentation
Dim Sld As Slide
Dim Tbl As Table
Dim Rw As Long, Cl As Long
Set Prst = ActivePresentation
Set Sld = Prst.Slides(1)
Set Shp = Sld.Shapes(1)
Set Tbl = Shp.Table
With Tbl
For Rw = 1 To .Rows.Count
For Cl = 1 To .Columns.Count
With .Cell(Rw, Cl)
TXT = .Shape.TextFrame.TextRange.Text
If Rw < 2 Then
' Header ,Title
With .Shape.Fill
.ForeColor.RGB = RGB(47, 117, 181)
End With
Else
If Rw Mod 2 = 0 Then
With .Shape.Fill
.ForeColor.RGB = RGB(189, 215, 238)
.BackColor.RGB = RGB(189, 215, 238)
End With
Else
End If
If Cl > 1 And TXT <> "" And (TXT) <= -5 Then
With .Shape.Fill
.TwoColorGradient msoGradientVertical, 1
If Rw Mod 2 = 0 Then
.ForeColor.RGB = RGB(189, 215, 238)
.BackColor.RGB = RGB(189, 215, 238)
.GradientStops.Insert RGB(189, 215, 238), 0.51, 0
Else
.ForeColor.RGB = RGB(255, 255, 255)
.BackColor.RGB = RGB(255, 255, 255)
.GradientStops.Insert RGB(255, 255, 255), 0.51, 0
End If
.GradientStops.Insert RGB(255, 0, 0), 0.5, 0
.GradientStops.Insert RGB(255, 0, 0), 0, 0
End With
ElseIf Cl > 1 And TXT <> "" And (TXT) >= -5 Then
With .Shape.Fill
.TwoColorGradient msoGradientVertical, 1
If Rw Mod 2 = 0 Then
.ForeColor.RGB = RGB(189, 215, 238)
.BackColor.RGB = RGB(189, 215, 238)
.GradientStops.Insert RGB(189, 215, 238), 0.51, 0
Else
.ForeColor.RGB = RGB(255, 255, 255)
.BackColor.RGB = RGB(255, 255, 255)
.GradientStops.Insert RGB(255, 255, 255), 0.51, 0
End If
.GradientStops.Insert RGB(200, 200, 200), 0.5, 0
.GradientStops.Insert RGB(200, 200, 200), 0, 0
End With
End If
End If
End With
Next 'Cl
Next 'RW
End With
End Sub
Book1 | ||||||||||
---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | |||
1 | ||||||||||
2 | I would recommend to my friends and family | -4 | 1 | -4 | -3 | -6 | -2 | 0 | ||
3 | Works better than other brands | 1 | -2 | -1 | -1 | -1 | 0 | -1 | ||
4 | Application.ActivePresentation.Slides(1) | -3 | -3 | -4 | -4 | -2 | -1 | 0 | ||
5 | Is a brand I trust | -7 | 0 | -5 | -4 | -3 | 0 | -3 | ||
6 | Leaves skin feeling hydrated | -3 | -3 | -3 | -1 | 2 | -1 | -4 | ||
7 | Is good value for tie money | -4 | -4 | -5 | -2 | 0 | -1 | |||
8 | Is a brand that shares my values | -5 | 3 | -5 | -5 | -5 | -1 | 6 | ||
9 | Gcod for sensitive skin | 7 | -1 | 7 | 5 | 3 | -2 | -2 | ||
10 | Offers the most advanced formulas and technology | 5 | -4 | 2 | 1 | 1 | 1 | 1 | ||
11 | Contains natural ingredients that really work | -4 | 21 | -3 | -3 | -1 | -3 | 7 | ||
12 | Helps heal and relieve skin issues | 4 | -3 | 3 | 8 | 6 | 8 | -4 | ||
13 | Are clinicalty proven to work | 8 | -5 | 8 | 7 | 3 | 3 | -5 | ||
14 | Is socially and environmentally responsible | -5 | 16 | -3 | -4 | -2 | -2 | 13 | ||
15 | Is recommended by doctors and dermatobogists | 16 | -7 | 16 | 13 | 9 | 2 | -5 | ||
Sheet1 |
Public Sub PPT_color_condtion()
Dim Shp As Shape
Dim Prst As Presentation
Dim Sld As Slide
Dim Tbl As Table
Dim Rw As Long, Cl As Long
Set Prst = ActivePresentation
Set Sld = Prst.Slides(1)
Set Shp = Sld.Shapes(1)
Set Tbl = Shp.Table
With Tbl
For Rw = 1 To .Rows.Count
For Cl = 1 To .Columns.Count
With .Cell(Rw, Cl)
TXT = .Shape.TextFrame.TextRange.Text
If Rw < 2 Then
' Header ,Title
With .Shape.Fill
.ForeColor.RGB = RGB(47, 117, 181)
End With
Else
If Rw Mod 2 = 0 Then
With .Shape.Fill
.ForeColor.RGB = RGB(189, 215, 238)
.BackColor.RGB = RGB(189, 215, 238)
End With
Else
End If
If Cl > 1 And TXT <> "" And (TXT) <= 0 Then
If TXT < 0 Then
N = (1 - (TXT / 100) * -1)
N = N - 0.1
Else
N = 0.99
End If
With .Shape.Fill
.TwoColorGradient msoGradientVertical, 1
If TXT <= -5 Then
Clr = RGB(255, 0, 0)
Else
Clr = RGB(150, 150, 150)
End If
If Rw Mod 2 = 0 Then
.ForeColor.RGB = RGB(255, 255, 255)
.BackColor.RGB = RGB(255, 255, 255)
.GradientStops.Insert RGB(189, 215, 238), N, 0
Else
.ForeColor.RGB = RGB(255, 255, 255)
.BackColor.RGB = RGB(255, 255, 255)
.GradientStops.Insert RGB(255, 255, 255), N, 0
End If
.GradientStops.Insert Clr, 0.99, 0
If N + 0.01 >= 0.99 Then N = 0.99
.GradientStops.Insert Clr, N, 0
End With
ElseIf Cl > 1 And TXT <> "" And (TXT) >= 0 Then
N = (TXT / 100) + 0.1
If TXT >= 5 Then
Clr = RGB(255, 0, 0)
Else
Clr = RGB(150, 150, 150)
End If
With .Shape.Fill
.TwoColorGradient msoGradientVertical, 1
If Rw Mod 2 = 0 Then
.ForeColor.RGB = RGB(189, 215, 238)
.BackColor.RGB = RGB(189, 215, 238)
.GradientStops.Insert RGB(189, 215, 238), N + 0.01, 0
Else
.ForeColor.RGB = RGB(255, 255, 255)
.BackColor.RGB = RGB(255, 255, 255)
.GradientStops.Insert RGB(255, 255, 255), N + 0.01, 0
End If
.GradientStops.Insert Clr, N, 0
.GradientStops.Insert Clr, 0, 0
End With
End If
End If
End With
Next 'Cl
Next 'RW
End With
End Sub
May, this what you want
PLZ feedback
VBA Code:Public Sub PPT_color_condtion() Dim Shp As Shape Dim Prst As Presentation Dim Sld As Slide Dim Tbl As Table Dim Rw As Long, Cl As Long Set Prst = ActivePresentation Set Sld = Prst.Slides(1) Set Shp = Sld.Shapes(1) Set Tbl = Shp.Table With Tbl For Rw = 1 To .Rows.Count For Cl = 1 To .Columns.Count With .Cell(Rw, Cl) TXT = .Shape.TextFrame.TextRange.Text If Rw < 2 Then ' Header ,Title With .Shape.Fill .ForeColor.RGB = RGB(47, 117, 181) End With Else If Rw Mod 2 = 0 Then With .Shape.Fill .ForeColor.RGB = RGB(189, 215, 238) .BackColor.RGB = RGB(189, 215, 238) End With Else End If If Cl > 1 And TXT <> "" And (TXT) <= 0 Then If TXT < 0 Then N = (1 - (TXT / 100) * -1) N = N - 0.1 Else N = 0.99 End If With .Shape.Fill .TwoColorGradient msoGradientVertical, 1 If TXT <= -5 Then Clr = RGB(255, 0, 0) Else Clr = RGB(150, 150, 150) End If If Rw Mod 2 = 0 Then .ForeColor.RGB = RGB(255, 255, 255) .BackColor.RGB = RGB(255, 255, 255) .GradientStops.Insert RGB(189, 215, 238), N, 0 Else .ForeColor.RGB = RGB(255, 255, 255) .BackColor.RGB = RGB(255, 255, 255) .GradientStops.Insert RGB(255, 255, 255), N, 0 End If .GradientStops.Insert Clr, 0.99, 0 If N + 0.01 >= 0.99 Then N = 0.99 .GradientStops.Insert Clr, N, 0 End With ElseIf Cl > 1 And TXT <> "" And (TXT) >= 0 Then N = (TXT / 100) + 0.1 If TXT >= 5 Then Clr = RGB(255, 0, 0) Else Clr = RGB(150, 150, 150) End If With .Shape.Fill .TwoColorGradient msoGradientVertical, 1 If Rw Mod 2 = 0 Then .ForeColor.RGB = RGB(189, 215, 238) .BackColor.RGB = RGB(189, 215, 238) .GradientStops.Insert RGB(189, 215, 238), N + 0.01, 0 Else .ForeColor.RGB = RGB(255, 255, 255) .BackColor.RGB = RGB(255, 255, 255) .GradientStops.Insert RGB(255, 255, 255), N + 0.01, 0 End If .GradientStops.Insert Clr, N, 0 .GradientStops.Insert Clr, 0, 0 End With End If End If End With Next 'Cl Next 'RW End With End Sub
View attachment 24339