VBA按单元格值设形状颜色报错‘Object required’及批量处理求助

首先咱们一步步搞定你遇到的「Object required」错误，再扩展到批量处理所有工作表的需求：

一、修复单个工作表的错误与逻辑问题 #

你的代码里有三个关键问题导致报错和功能失效：

1. 拼写错误：ActiveSheets应该是ActiveSheet（单数，VBA里当前活动工作表的对象是ActiveSheet，复数形式ActiveSheets是工作表集合，不能直接这样调用）
2. 逻辑错误：你先把目标形状设为橙色，立刻又改成灰色，等于没做高亮操作；而且没有先把其他形状置灰，达不到「匹配高亮、其余置灰」的效果
3. 缺少错误处理：如果N8里的名称不存在对应的形状，代码会直接报错

修复后的单个工作表代码如下：

Sub Box_Colour_SingleSheet()
    Dim ws As Worksheet
    Dim targetShapeName As String
    Dim shp As Shape
    
    ' 指定当前活动工作表
    Set ws = ActiveSheet
    ' 获取N8单元格的目标形状名称
    targetShapeName = ws.Range("N8").Value
    
    ' 先把所有形状置灰
    For Each shp In ws.Shapes
        shp.Fill.ForeColor.RGB = RGB(166, 166, 166)
    Next shp
    
    ' 找到匹配的形状并高亮（加错误处理避免形状不存在时报错）
    On Error Resume Next
    Set shp = ws.Shapes(targetShapeName)
    If Not shp Is Nothing Then
        shp.Fill.ForeColor.RGB = RGB(237, 125, 49) ' 橙色高亮
    End If
    On Error GoTo 0
End Sub

二、扩展到所有工作表的批量处理 #

要一次性处理所有工作表，只需要遍历工作簿里的每一个工作表，对每个工作表重复「读取N8→所有形状置灰→匹配形状高亮」的逻辑即可，代码如下：

Sub Box_Colour_AllSheets()
    Dim ws As Worksheet
    Dim targetShapeName As String
    Dim shp As Shape
    
    ' 遍历工作簿中的每一个工作表
    For Each ws In ThisWorkbook.Worksheets
        ' 获取当前工作表N8单元格的目标形状名称
        targetShapeName = ws.Range("N8").Value
        
        ' 先把当前工作表的所有形状置灰
        For Each shp In ws.Shapes
            shp.Fill.ForeColor.RGB = RGB(166, 166, 166)
        Next shp
        
        ' 找到当前工作表中匹配的形状并高亮（加错误处理）
        On Error Resume Next
        Set shp = ws.Shapes(targetShapeName)
        If Not shp Is Nothing Then
            shp.Fill.ForeColor.RGB = RGB(237, 125, 49) ' 橙色高亮
        End If
        On Error GoTo 0
    Next ws
    
    MsgBox "所有工作表的形状颜色已更新完成！", vbInformation
End Sub

额外说明 #

• 错误处理部分On Error Resume Next和On Error GoTo 0是为了避免当N8里的名称没有对应形状时，代码直接崩溃，提升稳定性
• 如果你不想处理某些特定工作表，可以在For Each ws循环里加判断，比如If ws.Name <> "汇总表" Then ...跳过不需要的表

内容的提问来源于stack exchange，提问作者Arnab Biswas