giovedì 11 settembre 2014

Correzione di un problema con le date (gestione date in VBA)

ALT!

Nel codice che ho costruito c'è un grossolano errore!

Se io aggiungo semplicemente a Month(Date) un numero, per ottenere il mese successivo, va tutto bene se non è dicembre, perché in questo caso il numero del mese sarà 13, e verrà fuori sicuramente un errore quando vorrò rendere il nome del mese con MonthName.

Ecco qualchs prova...
Sub anno()
Dim d As Date
d = CDate("30/12/2013")
Debug.Print MonthName(Month(d) + 1)
End Sub
E infatti ottengo un'interruzione dell'esecuzione con l'avviso Chiamata di routine o argomento non validi.

Ho fatto una prova con l'aggiunta di giorni:
Sub anno()
Dim d As Date
d = CDate("30/12/2013")
Debug.Print MonthName(Month(d + 1))
Debug.Print MonthName(Month(d + 2))
End Sub
Aggiungendo un numero intero a una data, il mese viene corretto, perché si esegue un'operazione su una data, mentre aggiungendo un numero intero al mese di una data non si esegue un'operazione su una data ma su un numero intero, e quindi si può avere il paradosso che il mese diventi 13 eccetera...

Per assicurare che il numero sia veramente quello del mese, potrei "sintonizzarmi" sull'ultimo giorno del mese corrente e aggiuntere un giorno alla data... o magari sul 28 e aggiungere 4 in modo da comprendere tutti i mesi e trovarmi con certezza nel mese successivo...

Vediamo come si estrae il 28 del mese corrente partendo da Date...

Sub anno()
Dim d As Date
d = CDate("28/" & Month(Date) & "/" & Year(Date))
Debug.Print MonthName(Month(d))
d = d + 4
Debug.Print MonthName(Month(d))
End Sub
...nella finestra di Debug:
settembre
ottobre

Ecco: perfetto.

Riapplichiamola al programma...

Sub AggiungiFoglio()
    Dim NomeMese As String
    Dim d As Date
    d = CDate("28/" & Month(Date) & "/" & Year(Date))
    NomeMese = MonthName(Month(d + 4))
    
    Sheets(Sheets.Count).Select
    If Sheets(Sheets.Count).Name <> NomeMese Then

        Sheets.Add
        ActiveSheet.Name = NomeMese
        ActiveSheet.Move After:=Sheets(Sheets.Count)
    
        Sheets(Centralina).Select
    End If
End Sub
Ecco, adesso funziona!

Nessun commento:

Posta un commento