macro che inserisca il numero di pagina e stampi solo se in determinate celle vi sono valori

Anonimo
2011-05-26T21:07:32+00:00

Ho trovato in rete una macro che permette di stampare 4 pagine solo se determinate celle contengono un valore e contemporaneamente le numera.

Nel mio foglio sono impostate 4 pagine che ho la necessità di lasciare sempre impostate anche se non vengono sempre tutte compilate. Quello che mi servirebbe, è trovare una macro che riconosca quante pagine ho compilato e di conseguenza le stampi.

la prima pagina va da riga 1 a riga 65: se la riga 15 è compilata stampa pagina 1 di pagina 1 (n.di pagina compare nella riga 65)

la seconda pagina va da riga 66 a riga 130: se la riga 80 è compilata stampa pagina 1 e 2 di pagine 2 (n.di pagina compare nelle righe 65 e 130)

la terza pagina va da riga 131 a riga 195: se la riga 145 è compilata stampa pagina 1 , 2  e 3 di pagine 3 (n.di pagina compare nelle righe 65 , 130 e 195)

la quarta pagina va da riga 196 a riga 260: se la riga 210 è compilata stampa pagina 1 , 2 , 3 e 4 di pagine 4 (n.di pagina compare nelle righe 65 , 130, 195 e 260)

Il mio problema è che lanciando la macro mi crea sempre in qualsiasi caso la stampa di tutte e quattro le pagine. Ho dovuto accodare questa macro ad un'altra macro e forse è per questo motivo che non funziona....qualcuno mi può trovare la soluzione? qui di seguito riporto la mia macro intera....evidenzio in grassetto la parte finale che è quella che interessa la stampa

Sub ULTIMA()

'

' ULTIMA Macro

'

'

    Range("A10:G660").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _

        ("A2:G3"), CopyToRange:=Range("I10:O10"), Unique:=False

    Range("I11").Select

    ActiveCell.FormulaR1C1 = "1"

    Range("I12").Select

    ActiveCell.FormulaR1C1 = "=R[-1]C+1"

    Range("I12").Select

    Selection.AutoFill Destination:=Range("I12:I660"), Type:=xlFillDefault

    Range("I12:I660").Select

    ActiveWindow.ScrollRow = 685

    ActiveWindow.ScrollRow = 548

    ActiveWindow.ScrollRow = 411

    ActiveWindow.ScrollRow = 275

    ActiveWindow.ScrollRow = 138

    ActiveWindow.ScrollRow = 1

    Columns("I:I").Select

    Selection.Copy

    ActiveWindow.SmallScroll ToRight:=1

    Columns("Q:Q").Select

    ActiveSheet.Paste

    Columns("L:L").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll ToRight:=1

    Columns("R:R").Select

    ActiveSheet.Paste

    Columns("O:O").Select

    Application.CutCopyMode = False

    Selection.Copy

    Columns("S:S").Select

    ActiveSheet.Paste

    Columns("N:N").Select

    Application.CutCopyMode = False

    Selection.Copy

    Columns("T:T").Select

    ActiveSheet.Paste

    Columns("M:M").Select

    Application.CutCopyMode = False

    Selection.Copy

    Columns("U:U").Select

    ActiveSheet.Paste

    Range("R11:U60").Select

    Application.CutCopyMode = False

    Selection.Copy

    Sheets("ORDINI").Select

    Range("B15").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    Sheets("ARTICOLI").Select

    ActiveWindow.SmallScroll Down:=15

    Range("R61:U110").Select

    Selection.Copy

    Sheets("ORDINI").Select

    Range("G15").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    ActiveWindow.SmallScroll Down:=60

    Sheets("ARTICOLI").Select

    ActiveWindow.SmallScroll Down:=6

    Range("R111:U160").Select

    Selection.Copy

    Sheets("ORDINI").Select

    ActiveWindow.SmallScroll Down:=15

    Range("B80").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    Sheets("ARTICOLI").Select

    ActiveWindow.SmallScroll Down:=6

    Range("R161:U210").Select

    Selection.Copy

    Sheets("ORDINI").Select

    Range("G80").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    ActiveWindow.SmallScroll Down:=69

    Sheets("ARTICOLI").Select

    Range("R211:U260").Select

    Selection.Copy

    Sheets("ORDINI").Select

    ActiveWindow.SmallScroll Down:=-6

    Range("B145").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    ActiveWindow.SmallScroll Down:=0

    Sheets("ARTICOLI").Select

    Range("R261:U310").Select

    Selection.Copy

    Sheets("ORDINI").Select

    Range("G145").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    ActiveWindow.SmallScroll Down:=63

    Sheets("ARTICOLI").Select

    ActiveWindow.SmallScroll Down:=6

    Range("R311:U360").Select

    Selection.Copy

    Sheets("ORDINI").Select

    ActiveWindow.SmallScroll Down:=-3

    Range("B210").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    ActiveWindow.SmallScroll Down:=-3

    Sheets("ARTICOLI").Select

    Range("R361:U410").Select

    Selection.Copy

    Sheets("ORDINI").Select

    Range("G210").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    ActiveWindow.SmallScroll Down:=-6

    Dim lTot As Long    Dim lCont As Long    Dim lng As Long    Dim sh As Worksheet

Set sh = ThisWorkbook.Worksheets("ORDINI")

lTot = 0    lCont = 0        With sh        For lng = 1 To 260 Step 65            If .Cells(lng + 14, 1).Value <> "" Then                lTot = lTot + 1            End If        Next        For lng = 1 To 260 Step 65            If .Cells(lng + 14, 1).Value <> "" Then                lCont = lCont + 1                .Cells(lng + 64, 1).Value = "Pagina: " & lCont & " di Pagine: " & lTot                .PageSetup.PrintArea = "A" & lng & ": N" & lng + 64                .PrintOut                .PageSetup.PrintArea = ""            End If        Next        .Range("A65,A130,A195,A260").Value = ""    End With

Set sh = Nothing

End Sub

Microsoft 365 e Office | Excel | Per la casa | Windows

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti Nessun commento
Risposta accettata dall'autore della domanda
Anonimo
2011-05-30T10:24:27+00:00

Scusami ma ho fatto diverse prove e ho creato diversi fogli, ma i fogli che interessano l'ultima versione della macro sono:

ARTICOLI

ORDINI

la macro dev'essere lanciata quando ci si trova sul foglio ARTICOLI e si chiama ULTIMA, la macro SS è una delle tante prove che ho fatto....sono un pò una pasticciona pardon!!

Domanda(mia).

Perchè:

.PageSetup.PrintArea = "A" & lng & ": N" & lng + 64

e non:

.PageSetup.PrintArea = "A" & lng & ": J" & lng + 64

Aggiungo che quel codice è foriero di un sacco di problemi. Non esiste che se non sei sul foglio ARTICOLI la macro non funzioni. Prova a spiegare a parole, partendo dal file che hai postato, cosa vuoi ottenere. Grazie per la pazienza.

La risposta è stata utile?

0 commenti Nessun commento

19 risposte aggiuntive

Ordina per: Più utili
  1. Anonimo
    2011-05-28T12:19:50+00:00

    <iframe title ="Preview" scrolling="no" marginheight="0" marginwidth="0" frameborder="0" style="width:98px;height:115px;padding:0;background-color:#fcfcfc;" src="http://cid-edb2f5f1b26ab02d.office.live.com/embedicon.aspx/giusy/NOTA%20PER%20ORDINI%20CLIENTI%20GIUSY.xls"&gt;&lt;/iframe>

    http://cid-edb2f5f1b26ab02d.skydrive.live.com/redir.aspx?resid=EDB2F5F1B26AB02D!140

    grazie!!

    La risposta è stata utile?

    0 commenti Nessun commento
  2. Anonimo
    2011-05-28T09:35:05+00:00

    la cartella in cui ho inserito il file si chiama giusy, ma non sono sicura di essere riuscita a postare il link, scusa ma non ho ma non ho mai fatto questa procedura.

    i fogli che interessano la macro sono: ARTICOLI e ORDINI, la macro si chiama ULTIMA e dovrebbe essere lanciata quando ci si trova sul foglio ARTICOLI.

    Devi, per favore, postare l'indirizzo che trovi nella barra degli indirizzi del tuo browser quando sei nella cartella condivisa. Nuovamente vedi qui: Ricordati di postare il link alla cartella condivisa, vedi qui: http://www.maurogsc.eu/comefareperexcel/utilizzoskydrive.aspx i punti 2.15 e 2.16. Grazie.

    La risposta è stata utile?

    0 commenti Nessun commento
  3. Anonimo
    2011-05-27T20:30:56+00:00

    la cartella in cui ho inserito il file si chiama giusy, ma non sono sicura di essere riuscita a postare il link, scusa ma non ho ma non ho mai fatto questa procedura.

    i fogli che interessano la macro sono: ARTICOLI e ORDINI, la macro si chiama ULTIMA e dovrebbe essere lanciata quando ci si trova sul foglio ARTICOLI.

    La risposta è stata utile?

    0 commenti Nessun commento
  4. Anonimo
    2011-05-27T16:21:51+00:00

    Ho già fatto questa prova, ma non funziona.

    In anteprima il foglio bianco non lo vedo, ma quando stampo c'è questo problemino.

    Può magari essere dovuto al fatto che le prime righe di ogni foglio sono impostate con un'intestazione? non ho usato la funzione presente nella sezione imposta pagina, righe da ripetere in alto perchè altrimenti si sfasavano le righe interessate nella macro ed allora ho optato con la soluzione di impostare l'intestazione su tutti e quattro i fogli.

    Diventa difficile senza avere il documento originale. Puoi, per favore, postare e mettere in condivisione il file di Excel qui: http://explore.live.com/windows-live-skydrive .

    Ricordati di postare il link alla cartella condivisa, vedi qui: http://www.maurogsc.eu/comefareperexcel/utilizzoskydrive.aspx i punti 2.15 e 2.16.

    La risposta è stata utile?

    0 commenti Nessun commento