FormatCondition error with Excel 2007 - vba

The following code works splendidly on Excel 2013. But on Excel 2007 I get problems.
Function IsMasked() As Boolean
Dim wksTables As Worksheet
Set wksTables = GetSheetByCodename(ThisWorkbook, "wTables")
Dim loMask As ListObject
Set loMask = wksTables.ListObjects("tMask")
Dim lor As ListRow
For Each lor In loMask.ListRows
Dim sWorksheetName As String
Dim sRangeAddress As String
Dim sCompleteAddress As String
sWorksheetName = Intersect(lor.Range, loMask.ListColumns("Worksheet").DataBodyRange)
sRangeAddress = Intersect(lor.Range, loMask.ListColumns("Range").DataBodyRange)
Dim R As Range
Set R = ThisWorkbook.Worksheets(sWorksheetName).Range(sRangeAddress)
With R
Dim bMasked As Boolean
Dim fc As Object
For Each fc In .FormatConditions
If TypeName(fc) = "FormatCondition" Then
If fc.Interior.Color = RGB(0, 0, 0) And fc.Font.Color = RGB(0, 0, 0) Then
'Range has mask if any formatcondition is mask
bMasked = True
Exit For
End If
End If
Next fc
If bMasked = False Then
'Mask is false if any specified range does not have mask
Exit For
End If
End With
Next lor
IsMasked = bMasked
End Function
If fc.Interior.Color = RGB(0, 0, 0) And fc.Font.Color = RGB(0, 0, 0) evaluates to true even when the interior color is set to nothing and when the font color is red.
When I look at fc in the locals window a lot of the properties say application-defined or object-defined error. I don't know if this is any clue.

Related

Modifying shape colour based on cell value

Am looking to modify the shape colour based on a linked cell value ...
The shape is 'test' and the cell value "X11". I'm getting the error that the object does not support this property or method ...
Sub CChange()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
With ws.Shapes.Range(Array("test"))
If .Range("X11") = 1 Then
.Fill.ForeColor.RGB = RGB(18, 38, 43)
ElseIf .Range("X11") = 2 Then
.Fill.ForeColor.RGB = 0
End If
End With
End Sub
Change your code to this , your with statement is wrong.
You are not working with worksheet hence you cannot access range with .Range.
Sub CChange()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
With ws.Shapes.Range(Array("test"))
If ws.Range("X11") = 1 Then
.Fill.ForeColor.RGB = RGB(18, 38, 43)
ElseIf ws.Range("X11") = 2 Then
.Fill.ForeColor.RGB = 0
End If
End With
End Sub

Change color of the last point in a graph

I created a graph in VBA
But i want to the last point i have done is in another color (red)
here is my code :
Sub Macro2()
'
' Macro2 Macro
'
'
i = Range("G3").Select
j = Range("D3").Select
With ActiveChart.ChartArea.Select
i.MarkerBackgroundColor = RGB(250, 250, 250)
j.MarkerForegroundColor = RGB(250, 250, 250)
End With
End Sub
In i is the X abscisse and j is the Y abscisse of the last point !
thank you for any advice
This code will set the last marker on the chart to red. Note the the RGB value for red is (255, 0, 0)
Sub SetLastMarkerRed()
Dim ws As Worksheet
Dim ch As Chart
Dim sc As SeriesCollection
Dim s As Series
Dim p As Point
Set ws = ThisWorkbook.ActiveSheet
Set ch = ws.ChartObjects(1).Chart
Set sc = ch.SeriesCollection
Set s = sc.Item(1)
Set p = s.Points(s.Points.Count)
p.MarkerBackgroundColor = RGB(255, 0, 0)
p.MarkerForegroundColor = RGB(255, 0, 0)
Set ws = Nothing
Set ch = Nothing
Set sc = Nothing
Set s = Nothing
Set p = Nothing
End Sub
Your code works but it does this :

Ignore items in a formatconditions collection that are not formatcondition?

The following code works for most sheets in my workbook:
Function IsHighlighted() As Boolean
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
Dim rUsedRange As Range
Set rUsedRange = wks.UsedRange
With rUsedRange
Dim bHighlighted As Boolean
Dim fc As Object
For Each fc In .FormatConditions
If fc.Interior.Color = RGB(255, 0, 0) And fc.Font.Color = RGB(255, 255, 0) Then
bHighlighted = True
Exit For
End If
Next fc
If bHighlighted = True Then
Exit For
End If
End With
Debug.Print (wks.Name & "," & rUsedRange.FormatConditions.count)
Next wks
IsHighlighted = bHighlighted
End Function
But some of my sheets contain icon sets.
Apparently:
The FormatConditions collection includes FormatCondition, DataBar, AboveAverage, ColorScale, UniqueValues, Top10 and IconSetCondition objects, not just FormatCondition objects.
For more context, see: For each fc in range.formatconditions fails. Why?
Some of these don't have .Interior.Color so the if statement throws an error.
What is a nice way I can skip all of these objects in the formatconditions collection that are not of the type formatcondition?
I tried using VarType(fc) to determine the obejct type, but it only retuns a 9 which says that fc is some kind of object.
Did you try the Typename function,
for example:
Dim str as string.
Msgbox Typename(str) ' ->>> "String"

For each fc in range.formatconditions fails. Why?

The following code works for most sheets in my workbook:
Function IsHighlighted() As Boolean
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
Dim rUsedRange As Range
Set rUsedRange = wks.UsedRange
With rUsedRange
Dim bHighlighted As Boolean
Dim fc As FormatCondition
For Each fc In .FormatConditions
If fc.Interior.Color = RGB(255, 0, 0) And fc.Font.Color = RGB(255, 255, 0) Then
bHighlighted = True
Exit For
End If
Next fc
If bHighlighted = True Then
Exit For
End If
End With
Debug.Print (wks.Name & "," & rUsedRange.FormatConditions.count)
Next wks
IsHighlighted = bHighlighted
End Function
But it fails on the line For Each fc In .FormatConditions with the error message type mismatch on a worksheet that has rUsedRange.FormatConditions.Count = 34 out of which many are icon sets.
Why does the code fail on this sheet? How can I fix it?
The FormatConditions collection includes FormatCondition, DataBar, AboveAverage, ColorScale, UniqueValues, Top10 and IconSetCondition objects, not just FormatCondition objects, so you need to declare your fc variable as Object.

How can I select each shapes in loop?

Powerpoint 2010
I am trying to select on each new shape in the loop. But not all shapes in loop are selected. Always only the last shape is selected. What is wrong?
Thank you
Private Sub AddShapeRectangleOnSelectedText()
Dim oText As TextRange
Dim linesCount As Integer
Dim myDocument As Slide
Dim i As Integer
Dim s As Shape
' Get an object reference to the selected text range.
Set oText = ActiveWindow.Selection.TextRange
Set myDocument = ActiveWindow.View.Slide
linesCount = oText.Lines.Count
For i = 1 To linesCount
Set s = myDocument.Shapes.AddShape(msoShapeRectangle, _
oText.Lines(i).BoundLeft, oText.Lines(i).BoundTop, oText.Lines(i).BoundWidth, oText.Lines(i).BoundHeight)
With s
.Select
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(255, 255, 153)
.Fill.Transparency = 0.7
.Line.Visible = msoFalse
.Line.Transparency = 0#
End With
Next
End Sub
Select has an optional parameter to indicate whether the selection should replace the previous selection or not...
you can modify your code like this
.Select IIf(i = 1, True, False)