[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 :confused:
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]

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...:cry:
ome famo??:fagiano:

[zuper]

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

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??
:muro:
ariciao

[leomac]

zupper nenache col spezzettare l'union riesce anzi si blocca ad ogni range paste special:mc:
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. :muro:

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 :D

ciaociao

[MarcoGG]

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]

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.