sksanjeev786
Well-known Member
- Joined
- Aug 5, 2020
- Messages
- 961
- Office Version
- 365
- 2016
- Platform
- Windows
Hi Team,
Need your help in the below macro. As Macro is working perfectly and need to add
As of now below conditions is less than 5 and more than 5 only but I
I need to add conditions between
5 to 9.99 as Green
-5 to -9.99 as Light Red
=10 and Above Dark Blue
=-10 and below Dark Red
Need your help in the below macro. As Macro is working perfectly and need to add
As of now below conditions is less than 5 and more than 5 only but I
I need to add conditions between
5 to 9.99 as Green
-5 to -9.99 as Light Red
=10 and Above Dark Blue
=-10 and below Dark Red
VBA Code:
Sub colorformat()
Dim s As Slide
Dim oSh As Shape
Dim oTbl As Table
Dim lRow As Long
Dim lCol As Long
Dim cell As ReflectionFormat
For Each s In ActivePresentation.Slides
For Each oSh In s.Shapes
If oSh.HasTable Then
Set oTbl = oSh.Table
For lRow = 2 To oTbl.Rows.Count
For lCol = 3 To oTbl.Columns.Count
If IsNumeric(oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange) = True Then
If oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange >= 5 Then
oTbl.cell(lRow, lCol).Shape.Fill.ForeColor.RGB = RGB(102, 228, 102)
oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange.Font.Bold = True
Else
If oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange <= -5 Then
oTbl.cell(lRow, lCol).Shape.Fill.ForeColor.RGB = RGB(237, 102, 102)
oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange.Font.Bold = True
Else
If oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange = Null Then
End If
End If
End If
End If
Next
Next
End If
Next ' Shape
Next s
End Sub
Attachments
Last edited by a moderator: