mercoledì 24 settembre 2014

Evidenziare le occorrenze di tutti i turni fatti da una persona.

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...

Nessun commento:

Posta un commento