La mia realizzazione e' piu' generosa di quella di Mario, in linea con i criteri di esagerata abbondanza del nostro forum
Innanzitutto, nel Modulo Vba del foglio Dichiarazione mettiamo questo codice, che serve per compilare H2, se si compila il Nominativo in G2, e ad azzerare il Nominativo se si compila H2:
- Codice: Seleziona tutto
Dim OnG As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myMatch
If Not OnG Then
OnG = True
If Target.Address = "$G$2" Then
myMatch = Application.Match(Target.Value, Sheets("DB").Range("A1:A1000"), False)
If Not IsError(myMatch) Then
Range("H2").Value = Sheets("DB").Cells(myMatch, 2).Value
Else
Beep
End If
ElseIf Target.Address = "$H$2" Then
Range("G2").ClearContents
End If
OnG = False
End If
End Sub
Poi la stampa e' controllata da questa seconda macro, che va in un Modulo standard del vba:
- Codice: Seleziona tutto
Sub CoviDec()
Dim iNam As String, iFac As String
Dim I As Long, LastA As Long
'
'scegli printer
SelPrint = Application.Dialogs(xlDialogPrinterSetup).Show
If SelPrint = False Then
MsgBox "Stampa Cancellata"
Exit Sub
End If
'
iNam = Range("G2")
iFac = Range("H2")
If iNam <> "" Then
ActiveSheet.PrintOut
Else
LastA = Sheets("DB").Range("A1000").End(xlUp).Row
For I = 2 To LastA
Range("G2").Value = Sheets("DB").Cells(I, "A").Value
If InStr(1, Range("H2").Value & " ", iFac, vbTextCompare) > 0 Then
ActiveSheet.PrintOut
Application.Wait (Now + TimeValue("0:00:02"))
End If
Next I
End If
MsgBox ("Completato...")
End Sub
Il concetto e' che se si avvia la stampa col nominativo impostato allora verra' stampata la scheda del solo Nominativo; se e' impostata una Sede allora si stamperanno tutte le schede di quella Sede; se non e' impostato nulla allora si stamperanno le schede di tutti i Nominativi.
Non so anticipare il comportamento della coda di stampa nel caso si mandassero in stampa decine o centinaia di fogli in sequenza; ho inserito una Wait nel ciclo ma questa non puo' coprire i tempi di effettiva stampa.
La colonna
I e' inutile anche nella mia ipotesi
Il file con queste modifiche e' scaricabile qui:
https://www.dropbox.com/s/jnxv4btqltp69 ... .xlsm?dl=0Ciao a tutti