Условное форматирование текстового поля - Excel VBA

Question

У меня есть электронная таблица Excel для панели инструментов с текстовыми полями. В каждом текстовом поле есть формула, указывающая на ячейку, где формула применяется к необработанным данным.

Я ищу способ условного форматирования текстовых полей в зависимости от значения в текстовом поле или исходных данных, если это проще. По сути, если текстовое поле имеет значение больше единицы, я бы хотел, чтобы шрифт был зеленым, если оно меньше, я бы хотел, чтобы оно было красным. До сих пор мне было трудно делать это, и я был бы признателен всем. Ниже приведен мой код, но он не запустится. Я немного новичок, когда дело доходит до VBA.

Sub Test_Change_Text()

If ActiveSheet.Range("A1").Value > ActiveSheet.Range("B1").Value Then
ActiveSheet.Shapes.Range(Array("textbox 1")).Select
 With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font.Fill
  .Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
Else
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font.Fill
  .Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
End With
End With

End Sub

Обновление: код ниже мой окончательный рабочий код. Это учитывает три ограничения.

Sub ChangeText()
    Dim shap As Shape

    For Each shap In Sheets("Output").Shapes
        If shap.Type = msoTextBox Then
            If IsNumeric(shap.TextEffect.Text) Then
                If shap.TextEffect.Text >= 3 Then
                    shap.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 255, 0)
                Else
                    If shap.TextEffect.Text <= -3 Then
                        shap.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
                    Else
                        shap.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
                    End If
                End If

            End If
        End If
    Next shap

    MsgBox "Done"
End Sub

Answer 1

Если они являются обычными текстовыми полями (например, Вставить> Текстовое поле), вы можете попробовать это

Sub ChangeText(sht As Worksheet)
    Dim shap As Shape
    For Each shap In sht.Shapes
        If shap.Type = msoTextBox Then
            If IsNumeric(shap.TextEffect.Text) Then
                With shap.TextFrame2.TextRange.Font.Fill.ForeColor
                If CDbl(shap.TextEffect.Text) > 0 Then
                    .RGB = RGB(0, 255, 0)
                Else
                    .RGB = RGB(255, 0, 0)
                End If
                End With
            End If
        End If
    Next shap

End Sub

Answer 2

Предполагая, что ваши "текстовые поля" действительно являются фигурами со связанным текстовым содержимым:

Sub DoColor()

Dim shp As Shape, tmp

    For Each shp In ActiveSheet.Shapes
        'only operate on linked shapes
        If Len(shp.DrawingObject.Formula) > 0 Then
            tmp = shp.TextFrame.Characters.Text
            'ignore non-numeric values
            If IsNumeric(tmp) And Len(tmp) > 0 Then
                shp.TextFrame.Characters.Font.Color = _
                          IIf(tmp >= 0, vbGreen, vbRed)
            End If
        End If
    Next shp


End Sub