Ecco, il codice per evidenziare tutti i turni fatti da una stessa persona è stato confezionato, perlomeno nella sua linea base.
Adesso bisogna soltanto andare ad aggiustarlo.
Eccolo:
Sub evidenziaOccorrenze()
Dim c As Range
Dim firstAddress As String
Set c = Range("TurnoGiorno").Find(ActiveCell)
firstAddress = c.Address
Do
Set c = Range("TurnoGiorno").FindNext(c)
c.Interior.Color = vbGreen
Loop While c.Address <> firstAddress And c Is Nothing = False
End Sub
e viene chiamato dall'evento doppio click sulla cella della quale si deve cercare il contenuto in tutto il calendario, evento gestito nel modulo della cartella:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
evidenziaOccorrenze
End Sub
Ora però lo devo aggiustare: innanzitutto limitare la sua funzione al solo doppio click sulle celle dei turni, o forse, meglio ancora, a quelle della Lista Nomi Mese.
Proviamo:
Sub evidenziaOccorrenze()
Dim c As Range
Dim firstAddress As String
Set c = Range("TurnoGiorno").Find(ActiveCell.Formula)
If c Is Nothing = False Then
firstAddress = c.Address
Do
c.Interior.Color = vbGreen
Set c = Range("TurnoGiorno").FindNext(c)
Loop While c.Address <> firstAddress And c Is Nothing = False
End If
End Sub
Questa sembra essere la forma definitiva della routine adatta a cercare le occorrenze di un contenuto, dato che quella prima presentava diversi problemi.
Subordinando la sua esecuzione al solo doppio click sulle celle di ListaNomiMese nel modulo della cartella:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Intersect(Target, Range("ListaNomiMese")) Is Nothing = False Then
evidenziaOccorrenze
End If
End Sub
che chiama la routine nel modulo RoutinesDiCalcolo:
Sub evidenziaOccorrenze()
Dim c As Range
Dim firstAddress As String
Set c = Range("TurnoGiorno").Find(ActiveCell.Formula)
If c Is Nothing = False Then
firstAddress = c.Address
Do
c.Interior.Color = vbGreen
Set c = Range("TurnoGiorno").FindNext(c)
Loop While c.Address <> firstAddress And c Is Nothing = False
End If
End Sub
sembra che la cosa riesca piuttosto bene.
Adesso risistemiamo la ricerca in tutto il calendario e non solo nei turni di giorno...
Ecco: nella routine dell'evento doppio click:
Dim DoubleClickFlag As Boolean
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Intersect(Target, Range("ListaNomiMese")) Is Nothing = False Then
If DoubleClickFlag = False Then
evidenziaOccorrenze Range("TurnoGiorno")
evidenziaOccorrenze Range("TurnoNotte")
DoubleClickFlag = True
Else
For Each elemento In Range("TurnoGiorno").Cells
elemento.Interior.Color = vbWhite
Next
For Each elemento In Range("TurnoNotte").Cells
elemento.Interior.Color = vbWhite
Next
DoubleClickFlag = False
End If
End If
End Sub
in modo che al ripetersi del doppio click il foglio calendario ritorni tutto bianco.
E la routine, che viene chiamata due volte viene così aggiustata:
Sub evidenziaOccorrenze(campo As Range)
Dim c As Range
Dim firstAddress As String
Set c = campo.Find(ActiveCell.Formula)
If c Is Nothing = False Then
firstAddress = c.Address
Do
c.Interior.Color = vbGreen
Set c = campo.FindNext(c)
Loop While c.Address <> firstAddress And c Is Nothing = False
End If
End Sub
C'è qualcosa che, a naso, non mi piace nella routine dell'evento doppio click... magari me la rivedo dopo... Comunque funziona egregiamente, è solo una di quelle mie paranoie che a volte sono motivate e a volte no...
