확인란을 사용하여 인접하지 않은 인쇄 영역을 설정하십시오.

Question

'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 

Answer 1

저는 카운터와 범위 배열을 건너 뜁니다. 그냥 하나의 범위를 정의하고 추가하십시오. 같은 뭔가 :

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 

Answer 2

예, 당신은 그것을 단순화하고 당신이 당신의 체크 박스와 명명 된 범위에 만든 명명 규칙을 이용하여 많은을 단축 할 수 있습니다.

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 

또한 예를 들어, 코드 만 section 2를 인쇄하기를 원한다면 section 1을 포함했다 동안, 임의로 섹션을 선택할 수 있습니다 때문에, 당신이 한 것보다 더 많은 제어 할 수 있음을 알 수 있습니다.