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

screenshot dashboard

更新：以下代码是我最终的工作代码。这允许三个约束。

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

如果它们是常规文本框（即插入＆gt;文本框），您可以试试这个

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

文本框条件格式 - Excel VBA

2 个答案: