Excel 使用复选框设置非连续打印区域

在一位朋友（主要是他）的帮助下，我们编写了一些代码，根据5个对应的复选框，将5个可打印区域中的任意一个添加到工作表的打印区域。单击框将显示“添加到打印”区域，而另一个简单得多的命令行将清除该区域。下面的作品非常好，所以我想与大家分享，如果有人有不同或更简洁的方法，我们会很好奇地看到它。他很少用VBA编程，所以他不得不用蛮力通过它。无论如何，这是：

Private Sub Message_Click()

Dim Ranges() As Range
Dim rangeCount As Integer
rangeCount = 0

If ActiveSheet.OLEObjects("PrintArea1").Object.Value Then
    rangeCount = rangeCount + 1
    ReDim Preserve Ranges(rangeCount)
    Set Ranges(rangeCount) = Range("Sect1PULC", Range("Sect1PLLC").Offset(0, 1))
End If
If ActiveSheet.OLEObjects("PrintArea2").Object.Value Then
    rangeCount = rangeCount + 1
    ReDim Preserve Ranges(rangeCount)
    Set Ranges(rangeCount) = Range(Range("Sect2PULC"), Range("Sect2PLLC").Offset(0, 1))
End If
If ActiveSheet.OLEObjects("PrintArea3").Object.Value Then
    rangeCount = rangeCount + 1
    ReDim Preserve Ranges(rangeCount)
    Set Ranges(rangeCount) = Range(Range("Sect3PULC"), Range("Sect3PLLC").Offset(0, 1))
End If
If ActiveSheet.OLEObjects("PrintArea4").Object.Value Then
    rangeCount = rangeCount + 1
    ReDim Preserve Ranges(rangeCount)
    Set Ranges(rangeCount) = Range(Range("Sect4PULC"), Range("Sect4PLLC").Offset(0, 1))
End If
If ActiveSheet.OLEObjects("PrintArea5").Object.Value Then
    rangeCount = rangeCount + 1
    ReDim Preserve Ranges(rangeCount)
    Set Ranges(rangeCount) = Range(Range("Sect5aPULC"), Range("Sect5aPLLC").Offset(0, 1))

    rangeCount = rangeCount + 1
    ReDim Preserve Ranges(rangeCount)
    Set Ranges(rangeCount) = Range(Range("Sect5bPULC"), Range("Sect5bPLLC").Offset(0, 1))
End If


Dim PrintSection As Range
If rangeCount = 0 Then Exit Sub
If rangeCount = 1 Then Set PrintSection = Ranges(1)
If rangeCount = 2 Then Set PrintSection = Application.Union(Ranges(1), Ranges(2))
If rangeCount = 3 Then Set PrintSection = Application.Union(Ranges(1), Ranges(2), Ranges(3))
If rangeCount = 4 Then Set PrintSection = Application.Union(Ranges(1), Ranges(2), Ranges(3), Ranges(4))
If rangeCount = 5 Then Set PrintSection = Application.Union(Ranges(1), Ranges(2), Ranges(3), Ranges(4), Ranges(5))
If rangeCount = 6 Then Set PrintSection = Application.Union(Ranges(1), Ranges(2), Ranges(3), Ranges(4), Ranges(5), Ranges(6))

With ActiveSheet.PageSetup
 .PrintArea = PrintSection.Address
 .Orientation = xlPortrait
 .Zoom = False
 .FitToPagesWide = 1
 .FitToPagesTall = False
 .CenterHorizontally = True
End With

End Sub

---

我会跳过计数器和范围数组。只需定义一个范围并添加到其中。比如：

Dim wks As Worksheet, rngPrint As Range
Set wks = ActiveSheet

If wks.OLEObjects("CheckBox1").Object.Value = True Then
    If rngPrint Is Nothing Then
        Set rngPrint = wks.Range("I4:L9")
    Else
        Set rngPrint = Union(rngPrint, wks.Range("I4:L9"))
    End If
End If

If wks.OLEObjects("CheckBox2").Object.Value = True Then
    If rngPrint Is Nothing Then
        Set rngPrint = wks.Range("I12:L17")
    Else
        Set rngPrint = Union(rngPrint, wks.Range("I12:L17"))
    End If
End If

---

是的，您可以利用您在复选框和命名范围上所做的命名约定来简化它并大大缩短它

Private Sub Message_Click()
  Dim prtArea As String, i As Long
  For i = 1 To 5
    If Sheet2.OLEObjects("PrintArea" & i).Object.Value Then
        If Len(prtArea) > 0 Then prtArea = prtArea & ","
        prtArea = prtArea & Range("Sect" & i & "PULC").Address & ":" & _
          Range("Sect" & i & "PLLC").Offset(0, 1).Address
    End If
  Next

  With ActiveSheet.PageSetup
   .PrintArea = prtArea
   .Orientation = xlPortrait: .Zoom = False: .FitToPagesWide = 1
   .FitToPagesTall = False: .CenterHorizontally = True
  End With
End Sub

还要注意的是，这给了您比以前更多的控制，因为您可以任意选择节，而例如，如果您只想打印

节2，则代码必须包含
节1