| | Post: 62 | Registrato il: 19/01/2017
| Città: MILANO | Età: 56 | Utente Junior | 2010 | | OFFLINE | |
|
  03/05/2018 10:29 | |
Buongiorno a tutti, come da titolo ho la necessità di aggiustare una macro che ho compilato per copiare ed incollare da foglio attivo, cerco di spiegarmi meglio possibile, ho diversi fogli di consegna materiali a altrettanti diversi dipendenti e devo stampare una ricevuta di consegna, quindi mi sono predisposto un foglio di ricevuta con margini stampabili sul quale la macro va a copiare i dati (materiali consegnati e nominativo dipendente), la macro funziona, copia incolla i campi selezionati, stampa la ricevuta e ripulisce i campi tornando al foglio di consegna, il problema sta nel fatto che il foglio ricevuta è sempre lo stesso ma quello di consegna no, con la mia macro funzionante andrebbe bene ma dovrei compilare un'infinità di macro a seconda i fogli, volevo chiedere a chi è più esperto di me se è possibile modificare la mia macro in modo tale che possa copiare diversi campi da foglio attivo (foglio consegna, varia a seconda del dipendente), incollarli sul foglio ricevuta (sempre lo stesso), stamparla e poi ripulire i campi e torni sul precedente foglio di consegna da dove si è partiti, allego la mia macro, spero di essermi spiegato ![[SM=x423023]](http://www.erismag.it/Servizio/ForumExcel/Smiles/Faccina_0003.gif) macro Sub stampa_ricevuta()
'
' stampa_ricevuta Macro
'
'
'
Application.ScreenUpdating = False
If Sheets("ricevuta").Visible = xlVeryHidden Then
Sheets("ricevuta").Visible = True
End If
Sheets("ricevuta").Unprotect Password:="abc"
Sheets("consegna").Select
Range("B14:M14").Select
Selection.Copy
Sheets("ricevuta").Select
Range("B14:M14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("consegna").Select
Range("F7").Select
Selection.Copy
Sheets("ricevuta").Select
Range("E7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
On Error GoTo errHandler
With ActiveSheet.PageSetup
.Orientation = xlLandscape
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Range("B14:M14").Select
Selection.ClearContents
Range("E7").Select
Selection.ClearContents
Sheets("ricevuta").Protect Password:="abc"
If Sheets("ricevuta").Visible = True Then
Sheets("ricevuta").Visible = xlVeryHidden
End If
Sheets("consegna").Select
Range("B14").Select
Application.ScreenUpdating = True
Exit Sub
errHandler:
Sheets("ricevuta").Protect Password:="abc"
If Sheets("ricevuta").Visible = True Then
Sheets("ricevuta").Visible = xlVeryHidden
End If
MsgBox "!!! ATTENZIONE ERRORE STAMPANTE !!! Non sono riuscito a stampare"
End With
End Sub
|
|
| | Post: 3.725 | Registrato il: 21/06/2013
| Città: NAPOLI | Età: 70 | Utente Master | Excel 365 | | OFFLINE |
|
| 03/05/2018 11:59 | |
Meglio se alleghi un file. [Modificato da alfrimpa 03/05/2018 11:59]
Alfredo |
| | Post: 2.871 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 03/05/2018 12:02 | |
Buona giornata, aquila-67; personalmente dovrei condurre alcuni Test, quindi, sarebbe opportuno allegassi un file (senza Dati sensibili) con alcuni Record significativi già inseriti e chiarissi ciò che desideri ottenere. Questo eviterebbe a chi desidera aiutarti dover ricostruire una probabile struttura con il rischio di non centrare l'obiettivo. Buon Lavoro. Giuseppe P.s. Leggo solo ora la risposta di Alfredo; mi scuso per la sovrapposizione.[Modificato da GiuseppeMN 03/05/2018 12:03]
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
| | Post: 62 | Registrato il: 19/01/2017
| Città: MILANO | Età: 56 | Utente Junior | 2010 | | OFFLINE | |
|
| 03/05/2018 13:16 | |
Ho preparato un file diciamo "alleggerito" perche il foglio conterrebbe anche giacenze, anagrafiche e cosi via, questa è la parte che interessa, di fogli consegna ce ne sono altri ovviamente perchè "ad personam" mentre la ricevuta è quella unica, sul foglio consegna di fianco a destra ci sono i pulsanti di stampa, ne ho messi 3 funzionati con altrettante macro, ma dovranno essere 60 (con altrettante macro una per riga e fin qui lo farò), ma moltiplicando per le persone diventa veramente eccessivo ecco il perche ho chiesto il Vostro aiuto. |
| | Post: 2.872 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 03/05/2018 17:08 | |
Buona sera, acquila-67; mi sembra di capire che nel Foglio di lavoro "ricevuta" in Cella "E7" viene sempre copiato il Valore della Cella "F" del Foglio di lavoro "consegna" quindi nel Foglio di lavoro "ricevuta" in Cella "E7": ... magari senza "Celle unite"! Fatto ciò, pensavo di utilizzare la Colonna "A" del Foglio di lavoro "consegna" per mettere un Flag sui Record da stampare. Un solo Codice VBA potrebbe fare tutto il resto; intendiamoci potrei sbagliarmi ma credo potrebbe funzionare. Cosa ne pensi? A dispsoizione. Buona serata. Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
| | Post: 63 | Registrato il: 19/01/2017
| Città: MILANO | Età: 56 | Utente Junior | 2010 | | OFFLINE | |
|
| 03/05/2018 17:16 | |
al flag non avevo pensato, infatti avevo messo un pulsante ogni riga, se si può fare va bene forse anche meglio, in E7 della ricevuta viene copiato il nome corrente della persona dal foglio "consegna" |
| | Post: 2.874 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 03/05/2018 19:41 | |
Buona sera, acquila-67;
ho impiegato un pò di tempo per testare il Codice VBA sotto indicato perchè succede una cosa strana.
Il mio obbiettivo era quello di:
- nel Foglio di lavoro "consegna" seleziono con un Flag in Colonna "A" 1 Record e stampo quel Record
- nel Foglio di lavoro "consegna" seleziono con un Flag in Colonna "A" più Record e stampo tutti Record selezionati
Ora, la cosa funziona se eseguo il Codice VBA premendo "F8" in successione all'interno del Codice ma se lancio il Codice tramite il Pulsante dedicato mi stampa solo il primo Record selezionato.
Questo problema mi era già capitato altre volte ma non ho mai capito il motivo di questa disfunzione.
Option Explicit
Sub stampa_ricevuta_1_pg()
Application.ScreenUpdating = False
Dim CRc As Long, x As Long
Dim y As Byte, z As Byte
Sheets("consegna").Select
If Cells(13, 1).Value = 0 Then
MsgBox "Non è stato selezionato alcun Record."
End
End If
Sheets("ricevuta").Unprotect Password:="abc"
With Worksheets("ricevuta")
Range(.Cells(14, 2), .Cells(23, 13)).ClearContents
CRc = Range("B" & Rows.Count).End(xlUp).Row - 1
y = 14
For x = 14 To CRc
If Cells(x, 1) <> "" Then
Range(Cells(x, 2), Cells(x, 13)).Copy
.Cells(y, 2).PasteSpecial Paste:=xlPasteValues
y = y + 1
z = z + 1
If z = Cells(13, 1) Then Exit For
End If
Next x
On Error GoTo errHandler
Sheets("ricevuta").Select
ActiveWindow.SelectedSheets.PrintPreview
' With ActiveSheet.PageSetup
' .Orientation = xlLandscape
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Range(.Cells(14, 2), .Cells(23, 13)).ClearContents
Sheets("ricevuta").Protect Password:="abc"
Range("B14").Select
Sheets("consegna").Select
Range(Cells(14, 1), Cells(CRc, 1)).ClearContents
Exit Sub
errHandler:
Sheets("consegna").Select
Range(Cells(14, 1), Cells(CRc, 1)).ClearContents
End With
Application.ScreenUpdating = True
End Sub
Come puoi ben vedere ho condotto i miei test con "Anteprima di stampa" quindi il Codice va modicato attivando la stama diretta.
A dispsoizione.
Buona serata.
Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
| | Post: 64 | Registrato il: 19/01/2017
| Città: MILANO | Età: 56 | Utente Junior | 2010 | | OFFLINE | |
|
| 03/05/2018 21:00 | |
Grazie, hai fatto un lavorone, ![[SM=x423028]](http://www.erismag.it/Servizio/ForumExcel/Smiles/Faccina_0008.gif) non capisco perche la stampa di piu record funzioni solo se lanciata da codice e non da pulsante, domani in ufficio cercherò di provare meglio |
| | Post: 2.875 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 03/05/2018 22:36 | |
Buona sera, acquila-67.
Prova e riprova credo di aver trovato una possibile soluzione; non è elegante ma sembra funzionare.
Option Explicit
Sub stampa_ricevuta_1_pg()
Application.ScreenUpdating = False
Dim CRc As Long, x As Long
Dim y As Byte, z As Byte
Sheets("consegna").Select
If Cells(13, 1).Value = 0 Then
MsgBox "Non è stato selezionato alcun Record."
End
End If
If Cells(13, 1).Value > 10 Then
MsgBox "Sono stati selezionati troppi Record." & Chr(10) _
& "È possibile selezionare un massimo di 10 Record"
End
End If
Sheets("ricevuta").Unprotect Password:="abc"
With Worksheets("ricevuta")
Range(.Cells(14, 2), .Cells(23, 13)).ClearContents
CRc = Range("B" & Rows.Count).End(xlUp).Row - 1
y = 14
For x = 14 To CRc
If Cells(x, 1) <> "" Then
Range(Cells(x, 2), Cells(x, 13)).Copy
Sheets("ricevuta").Select
Cells(y, 2).PasteSpecial Paste:=xlPasteValues
y = y + 1
z = z + 1
If z = Cells(13, 1) Then Exit For
Sheets("consegna").Select
End If
Next x
On Error GoTo errHandler
Sheets("ricevuta").Select
'' Anteprima di stampa
ActiveWindow.SelectedSheets.PrintPreview
'' Stampa
' With ActiveSheet.PageSetup
' .Orientation = xlLandscape
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Range(.Cells(14, 2), .Cells(23, 13)).ClearContents
Sheets("ricevuta").Protect Password:="abc"
Range("B14").Select
Sheets("consegna").Select
Range(Cells(14, 1), Cells(CRc, 1)).ClearContents
Application.ScreenUpdating = True
Cells(14, 1).Select
Exit Sub
errHandler:
Sheets("consegna").Select
Range(Cells(14, 1), Cells(CRc, 1)).ClearContents
End With
Application.ScreenUpdating = True
Cells(14, 1).Select
End Sub
In ogni caso cercherò di capire l'inghippo dovuto a With Worksheets che, almeno in teoria, non avrebbe dovuto creare problemi.
Ultima osservazione, con la struttura del Foglio di lavoro "ricevuta" i Record selezionati non dovranno essere maggiori di 10
A dispsoizione.
Buona serata.
Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
| | Post: 65 | Registrato il: 19/01/2017
| Città: MILANO | Età: 56 | Utente Junior | 2010 | | OFFLINE | |
|
| 03/05/2018 23:18 | |
Così funziona, avevo capito che vi era un limite di record leggendo il codice ma 10 è più che sufficiente, quello che sono riuscito a capire è che se lancio la macro dal pulsante macro della scheda sviluppo funziona bene, mentre da qualsiasi pulsante (ho provato anche activex) no, funziona solo la prima volta dopo aver interrotto il debug, mistero
edit: non so perchè ma ho letto in giro che "rallentando" un po' potrebbe funzionare e funziona, ho aggiunto questa:
With Worksheets("ricevuta")
>>>>> Application.Wait (Now + TimeValue("00.00.01")) <<<<<<<<<
Range(.Cells(14, 2), .Cells(23, 13)).ClearContents
era solo per capire chi più esperto di me saprà perchè
penso comunque che il secondo codice sia più completo è impostato anche il limite dei 10 record
[Modificato da aquila-67 03/05/2018 23:32] |
| | Post: 2.876 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 04/05/2018 00:06 | |
@aquila-67, scrive:
... quello che sono riuscito a capire è che se lancio la macro dal pulsante macro della scheda sviluppo funziona bene, mentre da qualsiasi pulsante (ho provato anche activex) no, funziona solo la prima volta dopo aver interrotto il debug, mistero ...
Forse non ho interpretato correttamente la tua Risposta #10 ma il codice VBA proposto in Risposta #9 nei Test che ho condotto funziona anche se lanciato dal Pulsante dedicato senza alcun limite. Se hai problemi posso allegare il File con il quale ho condotto i miei Test. Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
| | Post: 2.877 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 04/05/2018 08:09 | |
Solo per completezza:
@aquila-67, scrive
edit: non so perchè ma ho letto in giro che "rallentando" un po' potrebbe funzionare e funziona, ho aggiunto questa:
With Worksheets("ricevuta")
>>>>> Application.Wait (Now + TimeValue("00.00.01")) <<<<<<<<<
Range(.Cells(14, 2), .Cells(23, 13)).ClearContents
Effettivamente avevo seguito il consiglio di Mauro Gamberini in:
Questo Link
e applicato a:
For x = 14 To CRc
If Cells(x, 1) <> "" Then
Range(Cells(x, 2), Cells(x, 13)).Copy
Application.Wait (Now + TimeValue("00.00.01"))
.Cells(y, 2).PasteSpecial Paste:=xlPasteValues
y = y + 1
z = z + 1
If z = Cells(13, 1) Then Exit For
End If
Next x
In questo modo si risolve; il problema è che la mia scelta di utilizzare "With Worksheets" era volta ad evitare ".select" che rallenta l'esecuzione del Codice VBA ma con "Application.Wait" rallento maggiormente l'esecuzione del Codice VBA quindi, a mio avviso, non è una soluzione ottimale.
A disposizione.
Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
| | Post: 66 | Registrato il: 19/01/2017
| Città: MILANO | Età: 56 | Utente Junior | 2010 | | OFFLINE | |
|
| 04/05/2018 09:01 | |
Infatti è stata solo una prova fatta a tarda sera, utilizzo la seconda versione del codice che comprende anche l'avviso del limite dei 10 record |
| | Post: 67 | Registrato il: 19/01/2017
| Città: MILANO | Età: 56 | Utente Junior | 2010 | | OFFLINE | |
|
| 07/05/2018 12:54 | |
Buongiorno Giuseppe, ti chiedo una cortesia perche stò impazzendo con questa macro, nell'esempio funziona ma come la vado ad applicare operativamente fa le bizze, ho preso il foglio così come l'hai postato funzionante, ho sistemato i margini aggiustato qua e la qualcosa e non vuole andare più l'ultimo record (riga 24 in poi)non lo(li) vede proprio anche se selezionato da solo, ma nell'esempio si e non riesco a trovare dove sta il problema, allego il foglio con il problema che mi si crea |
| | Post: 2.892 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 07/05/2018 16:22 | |
Buon pomeriggio, aquila-67; leggo solo ora. Mi sembra di capire che il problema dipenda dal fatto che è stato tolto il Valore "Totali" in Cella "B74". Questo può sembrare banale ma considerando che: CRc = Range("B" & Rows.Count).End(xlUp).Row - 1trova la penultima Riga in Colonna "B" nel tuo esempio considera come ultima riga la Riga 23 e non la 24. Visto che la selezione prevede la stampa della "ricevuta" del Record in Riga 24 e il Ciclo si ferma alla Riga 23, quel Record non verrà mai considerato. Per farla breve, prova a togliere il "-1"; dovrebbe funzionare. A disposizione. Buon lavoro. Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
| | Post: 68 | Registrato il: 19/01/2017
| Città: MILANO | Età: 56 | Utente Junior | 2010 | | OFFLINE | |
|
| 07/05/2018 20:34 | |
Scusa il ritardo, ma sono riuscito a collegarmi solo ora, ho fatto una prova e sembra funzionare domani lo provo per bene sul file che ho in ufficio al quale sto lavorando e ti farò sapere, comprendo un pò il liguaggio di programmazione ma questa funzione per me è proprio ostica |
| | Post: 2.894 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 08/05/2018 08:14 | |
Buona giornata, aquila-67; la funzione indicata si occupa di identificare in modo dinamico l'ultima Riga valida. Nella struttura precedente in Cella "B74" avevi inserito la voce "Totali"; quindi per escludere dalle selezioni tale Riga ho indicato il "-1" Nella nuova struttura le Celle "B74" e "B75" sono vuote; in questo caso il "-1", giustamente, crea il problema che hai lamentato. A margine di quanto sopra corre l'obbligo di ricordare che la funzione in questione funziona egregiamente ma non in una struttura "Tabella". A disposizione. Buon lavoro. Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |
| | Post: 69 | Registrato il: 19/01/2017
| Città: MILANO | Età: 56 | Utente Junior | 2010 | | OFFLINE | |
|
| 08/05/2018 16:38 | |
Messo sul foglio di lavoro sta funzionando |
|
|
|
|