Question

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+d
'
    Sheets("JULY 1, 2015 DAY").Select
    ActiveSheet.Unprotect
    Range("I8:I11,I23:I28,V9:V18").Select
    Range("V9").Activate
    ActiveWindow.SmallScroll Down:=12
    Range("I8:I11,I23:I28,V9:V18,V23:V46").Select
    Range("V23").Activate
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
        Formula1:="=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Sheets("JULY 1, 2015 DAY").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

这是我想在几张纸上使用的宏的生成代码，我应该添加什么代码？

Answer 1

以下是一些基于工作表名称数组的代码。

Sub Create_CF_Rules()
    Dim w As Long, vWSs As Variant

    vWSs = Array("JULY 1, 2015 DAY", "JULY 2, 2015 DAY", "JULY 3, 2015 DAY")

    For w = LBound(vWSs) To UBound(vWSs)
        With Sheets(vWSs(w))
            .Unprotect
            With .Range("I8:I11,I23:I28,V9:V18,V23:V46")
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, Formula1:="=0"
                .FormatConditions(.FormatConditions.Count).SetFirstPriority
                With .FormatConditions(1).Interior
                    .PatternColorIndex = xlAutomatic
                    .Color = 5296274
                    .TintAndShade = 0
                End With
                .FormatConditions(1).StopIfTrue = False
            End With
            .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        End With
    Next w

End Sub

只需编辑vWSs = Array("...即可包含要添加新CF规则的所有工作表名称。没有提到删除现有规则，所以我没有提及。

Answer 2

这将对当前活动的工作表进行操作：

Sub Macro1()

    Dim ws As Worksheet, fc As FormatCondition

    Set ws = ActiveSheet

    ws.Unprotect

    Set fc = ws.Range("I8:I11,I23:I28,V9:V18,V23:V46").FormatConditions.Add( _
                      Type:=xlCellValue, Operator:=xlNotEqual, Formula1:="=0")
    With fc
        .SetFirstPriority
        .StopIfTrue = False
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 5296274
            .TintAndShade = 0
        End With
    End With

    ws.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

如何将录制的宏放在分隔的纸张上

2 个答案: