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 Sube 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 SubQuesta 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 Subche 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 Subsembra 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 Subin 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 SubC'è 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...
Nessun commento:
Posta un commento