Modifying shape colour based on cell value - vba

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

Related

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 :

Trying to dynamically update textboxes with values in VBA

I have put a map into excel of a building seating chart and created activeX text boxes on each spot where someone is sitting. I also have a list of each seat and the person sitting there. What I want to do is go through the list and assign the correct name to the textbox for each person. The name of each textbox is "TextBox____" where the blank is the seat name". I am getting an error on the "set tbox" line.
Sub UpdateMap()
Dim name As Variant
Dim tbox As MSForms.TextBox
Dim rng As Range
Dim cell As Range
With ThisWorkbook.Worksheets("5th floor map")
Set rng = .Range("A2:A5")
For Each cell In rng
ws = cell.Value
name = Application.VLookup(ws, .Range("A2:B5"), 2, False)
Set tbox = ThisWorkbook.Worksheets("5th floor map").Shapes("TextBox" & ws)
tbox.Value = name
Next
End With
End Sub
I only used the first four names/seats for this example, and used the for loop because in reality there are over 100 of these. Any suggestions for how i could make this work would be appreciated. Or if I am thinking about this totally wrong, please tell me that too. Thanks.
try this
Sub UpdateMap()
Dim rng As Range
Dim cell As Range
With ThisWorkbook.Worksheets("5th floor map")
Set rng = .Range("A2:A5")
For Each cell In rng
.OLEObjects("TextBox" & cell).Object.Text = cell.Offset(0, 1).Value
Next
End With
End Sub
try this
Sub oo()
Dim ol As OLEObject
Set ol = ThisWorkbook.Worksheets("MySheet").OLEObjects("TextBox1")
With ol
.Object.Text = "blabla"
.Object.ForeColor = RGB(0, 0, 192)
.Object.BorderStyle = fmBorderStyleSingle
.Object.SpecialEffect = fmSpecialEffectFlat
.Object.BackColor = RGB(192, 192, 192)
'.object.....
End With
End Sub

Change font colour of a textbox

I want to open an Excel file, go to the first sheet in the file, and change the text colour of textbox1 to red.
The only way I have managed to do it so far is via recording the macro.
It gives me
Workbooks.Open (fPath & sName)
Sheets(1).Select
ActiveSheet.Shapes.Range(Array("TextBox1")).Select
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 262).Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
.Solid
End With
That's fine; however the length of the text is variable so I get an error with the code if it is less than the 262 characters above.
I tried to introduce
CharCount = Len(textbox1.Text)
However I get error 424 Object required
I initially tried
Sheets(1).Select
ActiveSheet.TextBox1.ForeColor = RGB(255, 0, 0)
but got error 438 Object doesn't support this property or method.
If you want to change the font colour of the entire textbox (i.e. not just certain characters) then skip the Characters method. Also you shouldn't rely on .Select, ActiveSheet and the likes. Set proper references instead.
This works:
Dim wb As Workbook
Dim ws As Worksheet
Dim s As Shape
Set wb = Workbooks.Open(fPath & sName)
Set ws = wb.Sheets(1)
Set s = ws.Shapes("TextBox 1")
s.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
try this,
Sub Button2()
Dim sh As Shape
Set sh = Sheets("Sheet1").Shapes("Textbox1")
sh.TextFrame.Characters.Font.Color = vbRed
End Sub
I'm using Excel 2000 (long story) and I conditionally set the color of text box "M_in_out" in "Sheet7" with the following.
Private Sub M_in_out_LostFocus()
Dim sh As Sheet7
Set sh = Sheet7
vx = CInt(M_in_out.Value)
If vx > 0 Then
sh.M_in_out.ForeColor = vbBlack
Else
sh.M_in_out.ForeColor = vbRed
End If
sh.Cells(23, 6).Value = sh.Cells(23, 6).Value + vx
End Sub
You should probably use more meaningful variable names etc!.

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)