Stampare range non contigui nello stesso foglio

Question

Ciao a tutti

ho la necessità di stampare due range non contigui nello stesso foglio ponendoli uno sotto l'altro, es:

|----------------------------|

|        Range("A1:D15")      |

|___________________________|

|----------------------------|

|        Range("R10:Z20")     |

|___________________________|

Vorrei sapere se è possibile farlo evitando di copiare i due range su un foglio di appoggio utilizzando un codice vba

Grazie per l'interessamento

cari saluti

domenico

Answer 1

Ciao Domenico,

Ottimo Norman

ancora grazie.

Grazie a te, Domenico. per il cortese riscontro.

Per chiudere questo thread, vorrei chiederti gentilmente di segnare la mia risposta come Risposta. In questo modo, tu aiuterai anche coloro che potessero cercare soluzioni ai problemi simili negli archivi della Community.

===

Regards,

Norman

Answer 2

Ciao Domenico,

In realtà chiedevo la possibilità di stampare "senza" l'utilizzo di un foglio di appoggio.

Infatti, leggendo la tua domanda troppo frettolosamente, sono riuscito a non vedere la tua condizione di evitare l'uso di un foglio di appoggio! Tuttavia, non credo che sia possibile senza l'utilizzo di un intervallo di appoggio; se avessi creduto che lo fosse, avrei  postato altro codice perché, se non in caso di assoluta necessità o vantaggio particolare, cerco di evitare l'uso di fogli o intervalli di appoggio. Una possibile alternativa all'uso di un foglio di appoggio sarebbe inserire ulteriori colonne o righe nel foglio originale, utilizzare le nuove colonne o righe come area di stampa e quindi eliminarle. Tuttavia, la mia preferenza sarebbe per il foglio di appoggio. Detto questo,  visto che tu sei il cliente che pagerà, la scelta è tua -;))

Ma se non si può fare lo utilizzerò.

Approfitto per rivedere il codice per gestire la possibiltà che gli intervalli da stampare includessero delle formule e anche per assicurarsi che la larghezza delle colonne e l'altezza delle righe degli intervalli da stampare siano rispettate nella stampa. Quindi, sostituisci il codice precedente ccon la seguente versione:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet, tempSH As Worksheet

    Dim Rng As Range, Rng2 As Range

Const sIntervallo1 As String = "A1:D10"                                          '<<=== Modifica

    Const sIntervallo2 As String = "R10:Z20"                                     '<<=== Modifica

    Const sFoglio As String = "Foglio1"                                            '<<=== Modifica

    Set WB = ThisWorkbook

    With WB

        Set SH = WB.Sheets(sFoglio)

        Set tempSH = .Sheets.Add

    End With

    With SH

        Set Rng = .Range(sIntervallo1)

        Set Rng2 = .Range(sIntervallo2)

    End With

    Call Copia(Rng, tempSH)

    Call Copia(Rng2, tempSH)

    tempSH.PrintPreview    'PrintOut    

    Application.DisplayAlerts = False

    tempSH.Delete

    Application.DisplayAlerts = True

End Sub

'--------->>

Public Sub Copia(srcRng As Range, destSH As Worksheet)

    Dim destRng As Range

    Dim dAltezza As Double

    Dim i As Long, LRow As Long

    With srcRng

        LRow = LastRow(destSH)

        Set destRng = destSH.Range("A" & LRow + 1). _

                      Resize(.Rows.Count, .Columns.Count)

        .Copy

    End With

    On Error GoTo XIT:

    With Application

        CalcMode = .Calculation

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

    End With

    With destRng

        .PasteSpecial Paste:=xlPasteColumnWidths, _

                      Operation:=xlNone, _

                      SkipBlanks:=False, _

                      Transpose:=False

        .PasteSpecial Paste:=xlPasteFormats

        .PasteSpecial Paste:=xlPasteValues

    End With

    For i = 1 To srcRng.Rows.Count

        dAltezza = srcRng.Rows(i).RowHeight

        destRng.Rows(i).RowHeight = dAltezza

    Next i

XIT:

    With Application

        .Calculation = CalcMode

        .ScreenUpdating = True

    End With

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<=========

Ora mi preparo per il calcio!

Buon fine settimana.

===

Regards,

Norman

Answer 3

Ciao Domenico,

Aggiungerei che, utilizzando il secondo codice,  non se ne accorgerebbe dell'uso di un foglio di appoggio in quanto l'inserimento a l'eliminazione del nuovo foglio dovrebbero succedere in modo non visibile all'utente.

===

Regards,

Norman

Answer 4

Ciao Norman e grazie per il tuo interessamento.

In realtà chiedevo la possibilità di stampare "senza" l'utilizzo di un foglio di appoggio.

Ma se non si può fare lo utilizzerò.

cari saluti

domenico

Answer 5

Ciao Domenico,

Prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Menù | Inserisci | Modulo (oppure Alt+IM) per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet, tempSH As Worksheet

    Dim Rng As Range, Rng2 As Range

    Dim RngPrint As Range

    Const sIntervallo1 As String = "A1:D10"                                     '<<=== Modifica

    Const sIntervallo2 As String = "R10:Z20"                                    '<<=== Modifica

    Const sFoglio As String = "Foglio1"                                           '<<=== Modifica

    Set WB = ThisWorkbook

    With WB

        Set SH = WB.Sheets(sFoglio)

        Set tempSH = .Sheets.Add

    End With

    With SH

        Set Rng = .Range(sIntervallo1)

        Set Rng2 = .Range(sIntervallo2)

        Set RngPrint = Union(Rng, Rng2)

    End With

    With tempSH

        Rng.Copy Destination:=.Range("A1")

        Rng2.Copy Destination:=.Range("A1").Offset(Rng.Rows.Count)

        tempSH.PrintOut     '.PrintPreview

        Application.DisplayAlerts = False

        .Delete

        Application.DisplayAlerts = True

    End With

End Sub

'<<========= 

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm
• Alt+F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester | Esegui

Per testare il codice, ho creato un foglio di prova:

Eseguendo il codice, ottengo:

===

Regards,

Norman