[VBA/EXCEL '07] Un Range.Pastespecial che non "pasta"

[leomac]

Salve a tutti,
avrei un problema che non riesco a risolvere. O meglio 1 problema che non so se esiste o meno
Faccio partire il codice seguente:

Private Sub CommandButton1_Click() 'STAMPA IL MESE PER AGENZIA
'LA PRIMA VOLTA CHE SI AVVIA LA STAMPA DA ERRORE IN => Range("DZ63:DZ64").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                  'oppure in Range("DZ59:DZ62").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'incolla il nome e cognome nelle caselle
                  'NON CAPISCO IL MOTIVO. Il foglio risulta sbloccato e poi una volta che avviene l'errore e vado col debug, non modificando assolutamente nulla, faccio ripartire il tutto e funge O_O*
                  'FA LA STESSA COSA PER LA STAMPA INTERNO
Dim IntervalloNome2 As Range
Dim IntervalloIndirizzo2 As Range
Dim IntervalloRecapiti2 As Range
Dim PagaTecnico2 As Range
Dim Contratto2 As Range
Dim Altro2 As Range
Dim CostoAgenzia2 As Range
Dim IntervalloDati2 As Range
Dim TABELLA2 As Range
Dim IntervalloNome As Range
Dim IntervalloDati As Range
Dim DataIn As Object

If ComboBox1.text = "" Then
        msg = MsgBox("Nessun MESE selezionato." & Chr(13) & "Seleziona il MESE dall'elenco a discesa.", vbInformation, "Informazione")
        ComboBox1.DropDown
ElseIf ComboBox2.text = "" Then
        msg = MsgBox("Nessun ANNO selezionato." & Chr(13) & "Seleziona l'ANNO dall'elenco a discesa.", vbInformation, "Informazione")
        ComboBox2.DropDown
        
ElseIf TextBox1.Value = 0 And TextBox2.Value = 0 Then
        msg = MsgBox("Non è stato scelto il tipo di prospetto. Inserire il numero di copie del prospetto che si desidera stampare.", vbInformation, "Informazione")

Else:   A = ComboBox2.Value  ' prendi l'anno
        M = PrendiMese(ComboBox1.Value) ' prendi il mese
        Set zona = Range(Range("AA82"), Range("AA82").End(xlDown)).Rows
        DataBox = CDate(CStr(M) & "/" & CStr(A))
        Giorni = Day(DateSerial(A, M + 1, 0))
        For Each DataIn In zona
            If DataBox = DataIn Then
                msg = MsgBox("Il mese " & ComboBox1.text & Chr(32) & ComboBox2.text & " del tecnico " _
                      & Range("F13").text & Chr(32) & Range("F11").text & " è presente in contabilità." & Chr(13) & _
                      "Vuoi procedere con la stampa di N° " & TextBox1.Value & " prospetti per l'agenzia e di N° " & TextBox2.Value & " prospetto/i per l'interno?", vbYesNo + vbExclamation, "Avviso")
                If msg = vbYes Then
                    If TextBox1.Value <> 0 Then 'STAMPA PER AGENZIA
                        Application.ScreenUpdating = False
                        Set IntervalloNome = Union(Range("F11"), Range("F13"), Range("F15"), Range("F19")) ', Range("M23"), Range("M27")) 'prende il NOME E COGNOME ECC.
                        IntervalloNome.Copy ' lo copia
                        Sheets("MODULISTICA").Unprotect
                        Sheets("MODULISTICA").Select
                        Range("DZ59:DZ62").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'incolla il nome e cognome nelle caselle

                        Worksheets(".COGNOME NOME").Select 'va a mio modulo cioè al nome e cognome che prende dai dati appena inseriti in modulistica
                        Set IntervalloDati = Union(Range("M23"), Range("M27")) 'Numero contratto e la scadenza.
                        IntervalloDati.Copy ' lo copia
                        Worksheets("MODULISTICA").Select
                        Range("DZ63:DZ64").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'incolla il nome e cognome nelle caselle

                        Worksheets(".COGNOME NOME").Select 'va a mio modulo cioè al nome e cognome che prende dai dati appena inseriti in modulistica
                        DataIn.Select 'seleziona DataIn che poi è la DataBox
                        X = ActiveCell.Row 'identifica che numero di riga è
                        'data, giorno, assenza, ore lavoro inizio e fine H, ore totali h, ore tot %, pagate %, srtd %, fest %
                        Set IntervalloDati = Union(Range(Cells(X, 27), Cells(X + Giorni - 1, 28)), Range(Cells(X, 30), Cells(X + Giorni - 1, 32)), Range(Cells(X, 35), Cells(X + Giorni - 1, 35)), Range(Cells(X, 40), Cells(X + Giorni - 1, 43)))
                        IntervalloDati.Copy 'copio l'intervallo selezionato
                        Worksheets("MODULISTICA").Select
                        Range("DU71").Select 'vado a modulistica
                        ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'incolla tutto
                        Worksheets(".COGNOME NOME").Select
                        
                        Range("A1").Copy 'COPIA IL PERCORSO DELL'IMMAGINE
                        Worksheets("MODULISTICA").Select
                        Range("ED57").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        'ActiveSheet.Shapes("Rettangolo 1").Fill.UserPicture (Range("ED57").Value) 'inserisci immagine
                        Range("DU58:ED118").Select 'vado a modulistica e seleziono l'area da stampare
                        Application.CutCopyMode = False
                        
                        With ActiveSheet.PageSetup 'CONDIZIONI DI STAMPA
                            .LeftHeader = ""
                            .CenterHeader = ""
                            .RightHeader = ""
                            .LeftFooter = ""
                            .CenterFooter = ""
                            .RightFooter = ""
                            .LeftMargin = Application.InchesToPoints(0.196850393700787)
                            .RightMargin = Application.InchesToPoints(0.196850393700787)
                            .TopMargin = Application.InchesToPoints(0.196850393700787)
                            .BottomMargin = Application.InchesToPoints(0)
                            .HeaderMargin = Application.InchesToPoints(0)
                            .FooterMargin = Application.InchesToPoints(0)
                            .PrintHeadings = False
                            .PrintGridlines = False
                            .PrintComments = xlPrintNoComments
                            .PrintQuality = 600
                            .CenterHorizontally = True
                            .CenterVertically = True
                            .Orientation = xlPortrait
                            .Draft = False
                            .PaperSize = xlPaperA4
                            .FirstPageNumber = xlAutomatic
                            .Order = xlDownThenOver
                            .BlackAndWhite = False
                            .Zoom = False
                            .FitToPagesWide = 1
                            .FitToPagesTall = 1
                            .PrintErrors = xlPrintErrorsDisplayed
                            .OddAndEvenPagesHeaderFooter = False
                            .DifferentFirstPageHeaderFooter = False
                            .ScaleWithDocHeaderFooter = True
                            .AlignMarginsHeaderFooter = True
                            .EvenPage.LeftHeader.text = ""
                            .EvenPage.CenterHeader.text = ""
                            .EvenPage.RightHeader.text = ""
                            .EvenPage.LeftFooter.text = ""
                            .EvenPage.CenterFooter.text = ""
                            .EvenPage.RightFooter.text = ""
                            .FirstPage.LeftHeader.text = ""
                            .FirstPage.CenterHeader.text = ""
                            .FirstPage.RightHeader.text = ""
                            .FirstPage.LeftFooter.text = ""
                            .FirstPage.CenterFooter.text = ""
                            .FirstPage.RightFooter.text = ""
                        End With
                        Selection.PrintOut Copies:=TextBox1.Value
                        
                        Range("DZ59:DZ64").ClearContents
                        Range("DU71:ED101").ClearContents
                        Range("ED57").ClearContents
                        'ActiveSheet.Shapes("Rettangolo 1").Fill.UserPicture ("C:\TECNICI\no foto.gif") 'inserisci immagine
                        Worksheets(".COGNOME NOME").Select
                        DataIn.Select
                        C = C + 1
                        Application.ScreenUpdating = True
                    End If

in pratica al primo avvio del codice mi va in debug. Quindi vado a vedere il problema che almeno appaerentemente non trovo. Chiudo senza cambiare nulla, faccio riparitre il tutto e stampa normalmente. Purtroppo non sono riuscito ad allegare il file completo di excel (151 kb). Cmq se anche per voi il problema non è nel codice, mando il tutto per email.
Spero possiate aiutarmi.
1 saluto

[zuper]

Originariamente inviato da leomac

in pratica al primo avvio del codice mi va in debug. Quindi vado a vedere il problema che almeno appaerentemente non trovo. Chiudo senza cambiare nulla, faccio riparitre il tutto e stampa normalmente. Purtroppo non sono riuscito ad allegare il file completo di excel (151 kb). Cmq se anche per voi il problema non è nel codice, mando il tutto per email.
Spero possiate aiutarmi.
1 saluto

zippa il file e allegalo

[leomac]

zuper già avevo provato a zippapre ma purtroppo il file supera i 24.4 kb necessari per allegare...
ome famo??

[zuper]

Originariamente inviato da leomac

zuper già avevo provato a zippapre ma purtroppo il file supera i 24.4 kb necessari per allegare...
ome famo??

ma poi il foglio lo riproteggi a mano?

prova a sproteggerlo a mano all'inizio

[zuper]

se no prova a spezzettare il copy, almeno non devi star li a fare la union...

prendi cella per cella e la copi

[leomac]

Originariamente inviato da zuper
ma poi il foglio lo riproteggi a mano?
prova a sproteggerlo a mano all'inizio

anche senza protezione da l'errore lo stesso.

Originariamente inviato da zuper

se no prova a spezzettare il copy, almeno non devi star li a fare la union...
prendi cella per cella e la copi

mmm... provo ma non credo dipenda prorpio da quello e poi in quel modo allungherei di un botto il codice. Cmq spezzetto e ti fò sapere.
ciaociao

[leomac]

ma poi perchè l'union dovrebbe riportarmi problemi sul range paste special??

ariciao

[leomac]

zupper nenache col spezzettare l'union riesce anzi si blocca ad ogni range paste special
se potessi inviarti il file in qualche modo... email o altro ma non vorrei escludere il resto del forum dall'argomento.
ciaociao

[MarcoGG]

Più che spezzettare l'Union inizierei a cercare ed eliminare le possibili ambiguità presenti nel tuo codice.

Ad esempio vedo questo ( ho solo cambiato i rif. di cella ) :

    Dim IntervalloDati As Range

    Worksheets("Foglio1").Select
    Set IntervalloDati = Union(Range("A1"), Range("A3"))
    IntervalloDati.Copy
    Worksheets("Foglio2").Select
    Range("A1:A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Il .Select sui Fogli spesso è inutile, e non sortisce l'effetto desiderato ( in questo caso va in errore ). Le operazioni di copia/incolla possono essere fatte semplicemente riferendosi in modo esplicito agli oggetti coinvolti :

    Dim IntervalloDati As Range

    With Worksheets("Foglio1")
        Set IntervalloDati = Union(.Range("A1"), .Range("A3"))
    End With
    IntervalloDati.Copy
    Worksheets("Foglio2").Range("A1:A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Già così è molto meglio, se poi vogliamo risparmiare ancora più codice :

    With Worksheets("Foglio1")
        Union(.Range("A1"), .Range("A3")).Copy
    End With
    Worksheets("Foglio2").Range("A1:A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

[leomac]

MarcoGG grazie per l'intervento. Le porzioni di codice da te postate sicuramente hanno accorciato di molto molto il mio codice ma purtoppo non hanno risolto il problema. VBA mi segnala ancora una volta l'errore di run time 1004: Errore nel metodo paste special per la classe range.

ciaociao

[leomac]

Marco facendo un pò di modifiche mi sono accorto che l'errore avviene solo quando vado a ribloccargli il foglio. Difatti: Aziono la macro, va in debug, controllo il foglio dove deve pastare ed è "sprotetto". Quindi faccio ripartire la macro e fila tutto liscio. Se una volta che mi va in debug riblocco manualmente il foglio dove deve pastare, riazionando la macro mi ritorna in debug.
Credo che quindi il problema sia prorpio della protezione del foglio. Di conseguenza la domanda: Ma Sheets("MODULISTICA").Unprotect cosa fa allora? E' possibile che applichi tale comando solo dopo averne completati altri. Ciò magari dovuto ad un Application.ScreenUpdating = False.
Fammi sapere.

Ciaociao

[leomac]

Quoto quanto detto sopra.
L'errore era dovuto (o almeno cosi ho risolto) alla propedeuticictà tra Application.ScreenUpdating = False e Sheets("MODULISTICA").Unprotect. Difatti spostando il comando .Unprotect PRIMA dell' Application.ScreenUpdating fila tutto liscio regolarmente senza alcun debug.
Unica pecca è che mi mostra il foglio "modulistica"
Grazie mille a tutti

ciaociao

[MarcoGG]

Originariamente inviato da leomac

Marco facendo un pò di modifiche mi sono accorto che l'errore avviene solo quando vado a ribloccargli il foglio. Difatti: Aziono la macro, va in debug, controllo il foglio dove deve pastare ed è "sprotetto". Quindi faccio ripartire la macro e fila tutto liscio. Se una volta che mi va in debug riblocco manualmente il foglio dove deve pastare, riazionando la macro mi ritorna in debug.
Credo che quindi il problema sia prorpio della protezione del foglio. Di conseguenza la domanda: Ma Sheets("MODULISTICA").Unprotect cosa fa allora? E' possibile che applichi tale comando solo dopo averne completati altri. Ciò magari dovuto ad un Application.ScreenUpdating = False.
Fammi sapere.

Ciaociao

Non ho esaminato tutto il tuo codice, quindi non so cosa esattamente produca l'errore, se una singola istruzione posizionata male o una "sfortunata combinazione" di istruzioni... Se riesci a replicare lo stesso errore in un esempio più circoscritto ( tipo 10 righe di codice, tralasciando tutto il resto ), vedo di provare anch'io.

[MarcoGG]

Originariamente inviato da leomac

Unica pecca è che mi mostra il foglio "modulistica"

Forse perchè fai :
Sheets("MODULISTICA").Select

Non penso che Unprotect abbia bisogno di un Select preventivo.
Il .Select non è mai una buona cosa, meglio usarlo solo se strettamente necessario.