Пользовательский макрос области печати

Question

Я делаю макрос, который устанавливает область печати для выбранных пользователем областей документа.В основном, рядом с группой ячеек есть поле, и если пользователь поставит галочку, то ячейка будет включена в область печати.Вот мой код:

Sub TestCellA1()

    Dim t As Integer, d As Integer
    t = 0
    d = 20
    Dim rng_per As Range
    Set rng_per = Range("A3:E328") 'prints whole document
    Dim rng1 As Range

    If Not IsEmpty(Range("F19")) = True Then
        ActiveSheet.PageSetup.PrintArea = Range(rng_per)

    Else
        Do While t < 10
            If IsEmpty(Range("F" & d).Value) = True Then
                'MsgBox "Do not print"
            Else
                'MsgBox "Do print"
                ActiveSheet.PageSetup.PrintArea = rng1
            End If
            t = t + 1
            d = d + 25

        Loop

    End If
End Sub

Пока это работает до такой степени, что фактическая работа должна быть выполнена.Я планировал, что каждый раз, когда в цикле находит флажок, он добавляет эту часть документа в область печати.Как новичок в VBA, я понятия не имею, как добавить эти области в область печати.Есть идеи как это сделать?Заранее спасибо и хорошего дня.

Answer 1

Я мог бы сделать это несколькими различными способами, но я предлагаю следующее:

• Вы назначите ячейку для флажков.Присвойте формулу, если значение равно true (если флажок установлен), то создайте примерный диапазон «A1: B6» (соответственно измените).

• В цикле кода макроса через диапазон ячееккоторые либо пусты, либо содержат диапазон (по моему предложению вы можете использовать цикл):

  Sub Test()
  
  Rng = ""
  For X = 1 To 10 'Or whatever the number of your last used row would be
      If Cells(X, 1).Value <> "" Then
          If Rng = "" Then
              Rng = Cells(X, 1).Value
          Else
              Rng = Rng & "," & Cells(X, 1).Value
          End If
      End If
  Next X
  
  If Rng = "" then Rng = "A3:E328" 'Print whole range if no checkbox is checked
  ActiveSheet.PageSetup.PrintArea = Range(Rng).Address
  
  End Sub
  

Назначьте этот макрос всем вашим флажкам и повозитесь с ним.Он должен работать для вас (не смог проверить)

Answer 2

Если вы создадите и загрузите диапазон в rng_to_add, следующее будет принимать существующую PrintArea и Union (добавить к) rng_to_add:

' Going into this, you need to have declared a variable called rng_to_add
Dim rng_to_add As Range

' and loaded the range area you want to add to the PrintArea. This will
' be different for your particular situation.
Set rng_to_add = Sheets("Sheet1").Range("A1:C3")

' Referring to the current PageSetup of the Activesheet..
With ActiveSheet.PageSetup

    ' Check if the PrintArea of above PageSetup is empty
    If .PrintArea = "" Then
        ' If so, set the PrintArea to the address of the Range: rng_to_add
        .PrintArea = rng_to_add.Address
    Else
        ' If not, set it to the address of a union (append) of the existing
        ' PrintArea's range and the address of the Range: rng_to_add
        .PrintArea = Union(Range(.PrintArea), rng_to_add).Address
    End If

' End the reference to the current PageSetup of the Activesheet
End With

---

Итак, дляПереносимость и / или интеграция в ваши существующие подпрограммы, вы можете создать подпрограммы, которые управляют PrintArea следующим образом:

Sub Clear_PrintArea()
    ' Set PrintArea to nothing
    ActiveSheet.PageSetup.PrintArea = ""
End Sub


Sub Add_range_to_PrintArea(rng_to_add As Range)

    ' Referring to the current PageSetup of the Activesheet..
    With ActiveSheet.PageSetup

        ' Check if the PrintArea of above PageSetup is empty
        If .PrintArea = "" Then
            ' If so, set the PrintArea to the address of the Range: rng_to_add
            .PrintArea = rng_to_add.Address
        Else
            ' If not, set it to the address of a union (append) of the existing
            ' PrintArea's range and the address of the Range: rng_to_add
            .PrintArea = Union(Range(.PrintArea), rng_to_add).Address
        End If

    ' End the reference to the current PageSetup of the Activesheet
    End With

End Sub

Затем вы можете вызвать это так:

Clear_PrintArea
Add_range_to_PrintArea Range("A1:C3")
Add_range_to_PrintArea Range("A7:C10")
Add_range_to_PrintArea Range("A13:C16")