VBA代码If/Case语句跳过内部逻辑，无法设置星形颜色求助

问题描述 #

注：以下代码受NDA约束，无法展示更多内容。我需要在工作表中生成黑色或黄色的五角星，但代码执行完工作表选择步骤后直接跳回主代码。我尝试过If Then语句及当前的Select Case格式，无论目标单元格Cells(i, "s")中填入数字、True还是False，都会跳过内部逻辑。整个程序基于查找表开发，我仅需新增星形颜色设置功能。

原问题代码 #

Sub Star()
    Range(Cells(nxtRow, "B"), Cells(nxtRow + 1, "B")).Select
    With Selection
        .MergeCells = True
    End With
    '8.3x11 sheet
    If (p_size = 1) Then
        y = 171.25 + 43.5 * Mtimes
        ActiveSheet.Shapes.AddShape(msoShape5pointStar, 23.25, y, 22, 22).Select
        Select Case Cells(i, "s").Value
            'chooses yellow
            Case True
                Selection.ShapeRange.Fill.Visible = msoTrue
                Selection.ShapeRange.Fill.Solid
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
                Selection.ShapeRange.Fill.Transparency = 0#
                Selection.ShapeRange.Line.Weight = 0.75
                Selection.ShapeRange.Line.DashStyle = msoLineSolid
                Selection.ShapeRange.Line.Style = msoLineSingle
                Selection.ShapeRange.Line.Transparency = 0#
                Selection.ShapeRange.Line.Visible = msoTrue
                Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
                Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
            'chooses black
            Case False
                Selection.ShapeRange.Fill.Visible = msoTrue
                Selection.ShapeRange.Fill.Solid
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = 1
                Selection.ShapeRange.Fill.Transparency = 0#
                Selection.ShapeRange.Line.Weight = 0.75
                Selection.ShapeRange.Line.DashStyle = msoLineSolid
                Selection.ShapeRange.Line.Style = msoLineSingle
                Selection.ShapeRange.Line.Transparency = 0#
                Selection.ShapeRange.Line.Visible = msoTrue
                Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
                Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
            Case Else: MsgBox ("star color indeterminate")
        End Select
    '11x17 sheet
    ElseIf (p_size = 2) Then
        y = 160 + 33 * Mtimes
        ActiveSheet.Shapes.AddShape(msoShape5pointStar, 48#, y, 22, 22).Select
        Select Case Cells(i, "s").Value
            'chooses yellow
            Case True
                Selection.ShapeRange.Fill.Visible = msoTrue
                Selection.ShapeRange.Fill.Solid
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
                Selection.ShapeRange.Fill.Transparency = 0#
                Selection.ShapeRange.Line.Weight = 0.75
                Selection.ShapeRange.Line.DashStyle = msoLineSolid
                Selection.ShapeRange.Line.Style = msoLineSingle
                Selection.ShapeRange.Line.Transparency = 0#
                Selection.ShapeRange.Line.Visible = msoTrue
                Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
                Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
            'chooses black
            Case False
                Selection.ShapeRange.Fill.Visible = msoTrue
                Selection.ShapeRange.Fill.Solid
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = 1
                Selection.ShapeRange.Fill.Transparency = 0#
                Selection.ShapeRange.Line.Weight = 0.75
                Selection.ShapeRange.Line.DashStyle = msoLineSolid
                Selection.ShapeRange.Line.Style = msoLineSingle
                Selection.ShapeRange.Line.Transparency = 0#
                Selection.ShapeRange.Line.Visible = msoTrue
                Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
                Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
            Case Else: MsgBox ("star color indeterminate")
        End Select
    End If
End Sub

解决过程与修复代码 #

在Wookiee的协助下，我终于搞定了这个问题，核心修复点有两个：

1. 参数化行号变量：把i设为子过程的传入参数，这样调用时能正确传递目标行号，解决了之前代码跳转时变量未定义导致逻辑跳过的问题
2. 明确指定工作表：读取单元格值时加上了Sheets("d")前缀，确保从正确的工作表获取颜色控制值，避免因当前活动工作表不符导致读取无效值的情况；同时把黑色填充的SchemeColor从1改成了0，对应正确的黑色

修复后的代码（注：原代码末尾存在截断）：

Sub Star(i)
    Range(Cells(nxtRow, "B"), Cells(nxtRow + 1, "B")).Select
    With Selection
        .MergeCells = True
    End With
    '8.3x11 sheet
    If (p_size = 1) Then
        y = 171.25 + 43.5 * Mtimes
        ActiveSheet.Shapes.AddShape(msoShape5pointStar, 23.25, y, 22, 22).Select
        Select Case Sheets("d").Cells(i, "s").Value
            'chooses yellow
            Case True
                Selection.ShapeRange.Fill.Visible = msoTrue
                Selection.ShapeRange.Fill.Solid
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
                Selection.ShapeRange.Fill.Transparency = 0#
                Selection.ShapeRange.Line.Weight = 0.75
                Selection.ShapeRange.Line.DashStyle = msoLineSolid
                Selection.ShapeRange.Line.Style = msoLineSingle
                Selection.ShapeRange.Line.Transparency = 0#
                Selection.ShapeRange.Line.Visible = msoTrue
                Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
                Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
            'chooses black
            Case False
                Selection.ShapeRange.Fill.Visible = msoTrue
                Selection.ShapeRange.Fill.Solid
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = 0
                Selection.ShapeRange.Fill.Transparency = 0#
                Selection.ShapeRange.Line.Weight = 0.75
                Selection.ShapeRange.Line.DashStyle = msoLineSolid
                Selection.ShapeRange.Line.Style = msoLineSingle
                Selection.ShapeRange.Line.Transparency = 0#
                Selection.ShapeRange.Line.Visible = msoTrue
                Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
                Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
            Case Else: MsgBox ("star color not found")
        End Select
    '11x17 sheet
    ElseIf (p_size = 2) Then
        y = 160 + 33 * Mtimes
        A
End Sub

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