如何让B2出现不出字母时，椭圆和字变成另一种颜色

Benfyhu

请教各位老师：如何让B2出现不出字母时，椭圆和字变成另一种颜色，谢谢

蓝桥玄霜

什么叫“让B2出现不出字母”？哪个表的B2？
“椭圆和字”？哪里有椭圆？字是什么字？

麦穗要发光

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 判断是否是B2单元格发生变化
    If Not Intersect(Target, Worksheets("Sheet2").Range("B2")) Is Nothing Then
        ' 调用修改颜色的子程序
        Call ChangeColorIfNotABC
    End If
End Sub

Sub ChangeColorIfNotABC()
    ' 声明变量
    Dim ws As Worksheet
    Dim cellValue As String
    Dim shape As Shape
    Dim textColor As Long
    Dim fillColor As Long
   
    ' 设置工作表对象为Sheet2
    Set ws = ThisWorkbook.Sheets("Sheet2")
   
    ' 获取B2单元格的值
    cellValue = UCase(Trim(ws.Range("B2").Value))
   
    ' 如果B2单元格的值不是A、B或C且不是空值
    If cellValue <> "" And cellValue <> "A" And cellValue <> "B" And cellValue <> "C" Then
        ' 遍历所有图形对象并修改其颜色
        For Each shape In ws.Shapes
            On Error Resume Next
            ' 随机生成颜色
            textColor = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
            fillColor = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
            
            ' 修改文字颜色
            If shape.TextFrame2.HasText Then
                shape.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = textColor
            End If
            
            ' 修改填充颜色
            If Not shape.Fill Is Nothing Then
                shape.Fill.ForeColor.RGB = fillColor
            End If
            On Error GoTo 0
        Next shape
    End If
End Sub

麦穗要发光

是不是想要这样？

麦穗要发光

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 判断是否是B2单元格发生变化
    If Not Intersect(Target, Worksheets("Sheet2").Range("B2")) Is Nothing Then
        ' 调用修改颜色的子程序
        Call ChangeColorIfNotABC
    End If
End Sub

Sub ChangeColorIfNotABC()
    ' 声明变量
    Dim ws As Worksheet
    Dim cellValue As String
    Dim shape As Shape
    Dim textColor As Long
    Dim fillColor As Long
   
    ' 设置工作表对象为Sheet2
    Set ws = ThisWorkbook.Sheets("Sheet2")
   
    ' 获取B2单元格的值
    cellValue = UCase(Trim(ws.Range("B2").Value))
   
    ' 如果B2单元格的值不是A、B或C且不是空值
    If cellValue <> "" And cellValue <> "A" And cellValue <> "B" And cellValue <> "C" Then
        ' 遍历所有图形对象并修改其颜色
        For Each shape In ws.Shapes
            On Error Resume Next
            ' 随机生成颜色
            textColor = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
            fillColor = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
            
            ' 修改文字颜色
            If shape.TextFrame2.HasText Then
                shape.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = textColor
            End If
            
            ' 修改填充颜色
            If Not shape.Fill Is Nothing Then
                shape.Fill.ForeColor.RGB = fillColor
            End If
            On Error GoTo 0
        Next shape
    End If
End Sub

Benfyhu

蓝桥玄霜 发表于 2024-7-3 12:19
什么叫“让B2出现不出字母”？哪个表的B2？
“椭圆和字”？哪里有椭圆？字是什么字？

不好意思，写多两个 不出  字

Benfyhu

蓝桥玄霜 发表于 2024-7-3 12:19
什么叫“让B2出现不出字母”？哪个表的B2？
“椭圆和字”？哪里有椭圆？字是什么字？

放错了。附件，不好意思。图片的要求

Benfyhu

麦穗要发光 发表于 2024-7-3 13:43
是不是想要这样？

怎么我的变不了色的，帮忙看下附件。谢谢

麦穗要发光

Private Sub Worksheet_Change(ByVal Target As Range) 上边那部分，在vba窗口双击工作名，粘贴保存。Sub ChangeColorIfNotABC()的部分，插入块，粘贴保存。再试试
   

麦穗要发光

你的文件是不是还是错的？你要改的是这个文件？