Calendario per inserire data

Question

Ciao a tutti,

Chiedo il vostro aiuto per semplificare delle operazioni che mi ritrovo ad eseguire spesso manualmente con il rischio di commettere degli errori. Ho una cartella che utilizzo per stampare delle fatture, in linea di massima la data riportata nella cella J9 è uguale per tutte le fatture. Pertanto inserendola sul foglio1 (la cartella include 80 fogli tutti numerati in modo progressivo) e creando dei collegamenti a tutti i fogli viene riportata la data in tutte le fatture. Il problema si presenta quando in alcuni casi si presenta la necessità di riportare una data diversa ad alcune fatture esempio Foglio15 e Foglio63 interrompendo il collegamento. Visto che utilizzo la cartella su office 2016 e il calendario non è disponibile nel vba, navigando su internet ho trovato un file che copiandolo mi ha dato la possibilità di riprodurre su una userform il calendario. A quest’ultima ho pensato di aggiungere una textbox per raggiungere l’obiettivo che vado a spiegare.

Adesso arriva la parte difficile, esiste la possibilità inserendo il numero dei fogli che potrebbe essere 1:80 o nei casi in cui devo riportare solo per alcune fatture una data diversa inserire ad esempio 15,63 e riportare la data dopo averla selezionata dal calendario e aver cliccato sul commandbox sui fogli indicati?

Se esiste questa possibilità il formato della data deve essere es. 30/08/2017.

Questo è il file che ho preparato che da un'idea di quello che ho descritto sopra.

Questo è il file dal quale ho copiato il codice.

Grazie per l'attenzione.

Answer 1

Ok.

Qui trovi un file di esempio dove ho modificato il codice presente nella UserForm: File esempio #2

Le modifiche hanno riguardato la dichiarazione di una costate PW (attualmente valorizzata ="") dove inserre l'eventuale password utilizzata per proteggere tutti i fogli dedicati alle fatture. Nel caso di utilizzo di password ovviamente questa deve essere comune a tutti questi fogli.

Ho inoltre dichiarato una costante SuffissoNomeFatture (attualmente valorizzata ="Foglio") per gestire l'inserimento delle date nei soli fogli che hanno questo suffisso.

Se tu un domani volessi cambiare il suffisso ai fogli (es. Fattura o Fatt) ti basterà cambiare il testo del suffisso in corrispondenza di questa costante.

Al codice presente all'interno della UserForm ho aggiunto una "funzione" VBA (NumeroFatturePresenti) per determinare il numero di fogli che fanno da fatture. Numero che serve per poter verificare che un eventuale numero inserito negli intervalli (continuativi o alternati) non sia maggiore del numero di fogli dedicati alle fatture.

Per quanto riguarda la questione delle celle unite, che tanto sembra preoccuparti, in questo caso non dà luogo a problemi.

Nel caso un domani modificassi lo schema e cambiassi posizione al campo dedicato alla data fattura ti basterebbe modificare l'indirizzo della cella nella costante sCellaData.

Mi sono accorto che in due avvisi relativi ad intervalli di numeri fatture non valide il numero visualizzato non era corretto e ho provveduto a correggere.

Riporto di seguito tutto il codice presente nella userform (in grassetto le parti nuove/modificate):

'---

Option Explicit

Const PW As String = "" 'inserire qui la password di protezione. se non c'è password inserire ""

Const SuffissoNomeFatture As String = "Foglio" 'suffisso del nome dei fogli che fanno da fattura

Const ChrNC As String = "-" 'carattere per impostare i numeri fatture consecutivi a cui assegnare la date

Const ChrNA As String = "," 'carattere per impostare i numeri fatture alternati a cui assengare la data

Const sCellaData As String = "J9" 'indirizzo delle celle in cui verrà inserita la data eventualmente da personalizzare

Dim arrayNumeri As Variant

Dim NumI As Long

Dim NumF As Long

Dim VerificaNumeriOk As Boolean

Private Sub cmb_InserisciData_Click()

  Dim i As Long, t As Long

  With TB_Data

    If .Text = "" Then

      MsgBox "Inserire una data valida in formato gg/mm/aaaa", vbExclamation, "Data Non Valida"

      .SetFocus

      Exit Sub

    End If

  End With

  Call VerificaNumeri

  If VerificaNumeriOk Then

    Application.ScreenUpdating = False

      With ThisWorkbook

        For i = LBound(arrayNumeri) To UBound(arrayNumeri)

          If InStr(1, arrayNumeri(i), ChrNC) = 0 Then

With .Worksheets(SuffissoNomeFatture & CLng(arrayNumeri(i)))

.Unprotect PW

.Range(sCellaData).Value = CDate(TB_Data.Text)

.Protect PW

End With

          Else

            For t = NumI To NumF

With .Worksheets(SuffissoNomeFatture & t)

.Unprotect PW

.Range(sCellaData).Value = CDate(TB_Data.Text)

.Protect PW

End With

            Next t

          End If

        Next i

      End With

    Application.ScreenUpdating = True

    Unload Me

  Else

    TB_NumeroFatture.SetFocus

  End If

End Sub

Private Sub cmb_Esc_Click()

  Unload Me

End Sub

Private Sub TB_NumeroFatture_Change()

  Dim dig As String

  With TB_NumeroFatture

    dig = Right(.Text, 1)

    If dig = "." Then

      .Text = Left(.Text, Len(.Text) - 1) & ChrNA

      dig = ChrNA

    End If

    If Not IsNumeric(dig) And dig <> ChrNC And dig <> ChrNA And dig <> "" Then

      .Text = Left(.Text, Len(.Text) - 1)

    End If

  End With

End Sub

Private Sub TB_Data_Exit(ByVal Cancel As MSForms.ReturnBoolean)

  With TB_Data

    If Not IsDate(.Text) And .Text <> "" Then

      MsgBox "Inserire una data valida in formato gg/mm/aaaa", vbExclamation, "Data Non Valida"

      .Text = ""

      Cancel = True

    Else

      .Text = Format(.Text, "dd/mm/yyyy")

    End If

  End With

End Sub

Private Sub VerificaNumeri()

  Dim i As Long

  Dim cont As Long

  Dim NumeroMax As Long

  VerificaNumeriOk = True

  With TB_NumeroFatture

    Do While Right(.Text, 1) = ChrNC Or Right(.Text, 1) = ChrNA

      .Text = Left(.Text, Len(.Text) - 1)

    Loop

    If .Text = "" Then

      MsgBox "Inserire almeno un numero di fattura a cui assegnare la data", vbExclamation, "Numero Fattura"

      VerificaNumeriOk = False

      Exit Sub

    End If

    For i = 1 To Len(.Text)

      If Mid(.Text, i, 1) = ChrNC Then cont = cont + 1

      If cont > 1 Then

        MsgBox "Intervallo numeri fatture non valido." & vbCrLf & "Sono presenti più intervalli consecutivi!", _

               vbExclamation, "Intervallo Numeri Fatture Non Valido"

        VerificaNumeriOk = False

        Exit For

      End If

    Next i

    arrayNumeri = Split(.Text, ChrNA)

    NumeroMax = NumeroFatturePresenti

    For i = LBound(arrayNumeri) To UBound(arrayNumeri)

      If InStr(1, arrayNumeri(i), ChrNC) = 0 Then

        If arrayNumeri(i) = 0 Then

          MsgBox "Intervallo numeri fatture non valido." & vbCrLf & "Il numero 0 non è ammesso!", _

                 vbExclamation, "Intervallo Numeri Fatture Non Valido"

          VerificaNumeriOk = False

          Exit For

        End If

        If arrayNumeri(i) > NumeroMax Then

          MsgBox "Intervallo numeri fatture non valido." & vbCrLf & "Il numero " & arrayNumeri(i) & " non è ammesso!", _

                 vbExclamation, "Intervallo Numeri Fatture Non Valido"

          VerificaNumeriOk = False

          Exit For

        End If

      Else

        NumI = Left(arrayNumeri(i), InStr(1, arrayNumeri(i), ChrNC) - 1)

        NumF = Right(arrayNumeri(i), Len(arrayNumeri(i)) - InStr(1, arrayNumeri(i), ChrNC))

        If NumI = 0 Then

          MsgBox "Intervallo numeri fatture non valido." & vbCrLf & "Il numero 0 non è ammesso!", _

                 vbExclamation, "Intervallo Numeri Fatture Non Valido"

          VerificaNumeriOk = False

          Exit For

        End If

        If NumF = 0 Then

          MsgBox "Intervallo numeri fatture non valido." & vbCrLf & "Il numero 0 non è ammesso!", _

                 vbExclamation, "Intervallo Numeri Fatture Non Valido"

          VerificaNumeriOk = False

          Exit For

        End If

        If NumI > NumeroMax Then

          MsgBox "Intervallo numeri fatture non valido." & vbCrLf & "Il numero " & NumI & " non è ammesso!", _

                 vbExclamation, "Intervallo Numeri Fatture Non Valido"

          VerificaNumeriOk = False

          Exit For

        End If

        If NumF > NumeroMax Then

          MsgBox "Intervallo numeri fatture non valido." & vbCrLf & "Il numero " & NumF & " non è ammesso!", _

                 vbExclamation, "Intervallo Numeri Fatture Non Valido"

          VerificaNumeriOk = False

          Exit For

        End If

        If NumF < NumI Then

          MsgBox "Intervallo continuativo numeri fatture non valido." & vbCrLf & _

                 "Il numero iniziale (" & NumI & ") non può essere successivo al numero finale (" & NumF & ")!", _

                 vbExclamation, "Intervallo Numeri Fatture Non Valido"

          VerificaNumeriOk = False

          Exit For

        End If

      End If

    Next i

  End With

End Sub

Function NumeroFatturePresenti()

Dim ContF As Long

Dim wsF As Worksheet

For Each wsF In ThisWorkbook.Worksheets

If Left(wsF.Name, Len(SuffissoNomeFatture)) = SuffissoNomeFatture Then

ContF = ContF + 1

End If

Next wsF

NumeroFatturePresenti = ContF

End Function

'---

Answer 2

Ciao geacs,

premesso che non ho utilizzato il calendario per non doverlo "studiare" per capire come recuperare il valore della data, considerato che il problema della data è a mio parere il minore e che può essere gestita con inserimento della stessa in un TextBox, ti propongo questa possibile soluzione.

Eventualmente, se tu hai già visto come recuperare la data dal calendario, potrai adattare la parte non relativa alla data ma ai soli numeri alla UserForm del calendario.

In questo file esempio: File esempio

Ho inserito una UserForm così fatta:

Nel textbox Data va inserita la data.

Nel textbox NumeroFatture vanno inseriti i numeri delle fatture, in base alla posizione dei fogli, in cui inserire la data in precedenza indicata.

Ci sono dei controlli per verificare che venga inserita una data valida.

Per quanto riguarda i numeri è possibile inserire UN solo intervallo continuativoe il numero iniziale deve essere precedente a quello finale (es. puoi 1-5 ma NON 5-1).

E' possibile inserire un un numero "infinito" di numeri alternati senza particolari regole (es. puoi indicare 1,2,3 o 2,1,3 o 3,1,2 ecc.).

Nota che nel VBA ho impostato "-" per i numeri consecutivi e "," per i numeri alternati.

Ma ho fatto in modo che siano dichiarati come costanti nel modulo della UserForm e quindi puoi impostare i caratteri che più ti aggradano.

Vengono fatti dei controlli in modo che se per caso inserisci 0 la procedura non viene eseguita e viene dato un avviso.

Lo stesso se inserisci un numero superiore al numero di fogli presenti nella cartella di lavoro.

E sempre un avviso viene dato se in caso di indicazione di numeri consecutivi quello iniziale è maggiore di quello finale.

Questo il codice presente nella UserForm nominata UF_InserimentoData:

'---

Option Explicit

Const ChrNC As String = "-" 'carattere per impostare i numeri fatture consecutivi a cui assegnare la date

Const ChrNA As String = "," 'carattere per impostare i numeri fatture alternati a cui assengare la data

Const sCellaData As String = "J9" 'indirizzo delle celle in cui verrà inserita la data eventualmente da personalizzare

Dim arrayNumeri As Variant

Dim NumI As Long

Dim NumF As Long

Dim VerificaNumeriOk As Boolean

Private Sub cmb_InserisciData_Click()

  Dim i As Long, t As Long

  With TB_Data

    If .Text = "" Then

      MsgBox "Inserire una data valida in formato gg/mm/aaaa", vbExclamation, "Data Non Valida"

      .SetFocus

      Exit Sub

    End If

  End With

  Call VerificaNumeri

  If VerificaNumeriOk Then

    With ThisWorkbook

      For i = LBound(arrayNumeri) To UBound(arrayNumeri)

        If InStr(1, arrayNumeri(i), ChrNC) = 0 Then

          .Worksheets(CLng(arrayNumeri(i))).Range(sCellaData).Value = CDate(TB_Data.Text)

        Else

          For t = NumI To NumF

            .Worksheets(t).Range(sCellaData).Value = CDate(TB_Data.Text)

          Next t

        End If

      Next i

    End With

    Unload Me

  Else

    TB_NumeroFatture.SetFocus

  End If

End Sub

Private Sub cmb_Esc_Click()

  Unload Me

End Sub

Private Sub TB_NumeroFatture_Change()

  Dim dig As String

  With TB_NumeroFatture

    dig = Right(.Text, 1)

    If dig = "." Then

      .Text = Left(.Text, Len(.Text) - 1) & ChrNA

      dig = ChrNA

    End If

    If Not IsNumeric(dig) And dig <> ChrNC And dig <> ChrNA And dig <> "" Then

      .Text = Left(.Text, Len(.Text) - 1)

    End If

  End With

End Sub

Private Sub TB_Data_Exit(ByVal Cancel As MSForms.ReturnBoolean)

  With TB_Data

    If Not IsDate(.Text) And .Text <> "" Then

      MsgBox "Inserire una data valida in formato gg/mm/aaaa", vbExclamation, "Data Non Valida"

      .Text = ""

      Cancel = True

    Else

      .Text = Format(.Text, "dd/mm/yyyy")

    End If

  End With

End Sub

Private Sub VerificaNumeri()

  Dim i As Long

  Dim cont As Long

  Dim NumeroMax As Long

  VerificaNumeriOk = True

  With TB_NumeroFatture

    Do While Right(.Text, 1) = ChrNC Or Right(.Text, 1) = ChrNA

      .Text = Left(.Text, Len(.Text) - 1)

    Loop

    If .Text = "" Then

      MsgBox "Inserire almeno un numero di fattura a cui assegnare la data", vbExclamation, "Numero Fattura"

      VerificaNumeriOk = False

      Exit Sub

    End If

    For i = 1 To Len(.Text)

      If Mid(.Text, i, 1) = ChrNC Then cont = cont + 1

      If cont > 1 Then

        MsgBox "Intervallo numeri fatture non valido." & vbCrLf & "Sono presenti più intervalli consecutivi!", _

               vbExclamation, "Intervallo Numeri Fatture Non Valido"

        VerificaNumeriOk = False

        Exit For

      End If

    Next i

    arrayNumeri = Split(.Text, ChrNA)

    NumeroMax = ThisWorkbook.Worksheets.Count

    For i = LBound(arrayNumeri) To UBound(arrayNumeri)

      If InStr(1, arrayNumeri(i), ChrNC) = 0 Then

        If arrayNumeri(i) = 0 Then

          MsgBox "Intervallo numeri fatture non valido." & vbCrLf & "Il numero 0 non è ammesso!", _

                 vbExclamation, "Intervallo Numeri Fatture Non Valido"

          VerificaNumeriOk = False

          Exit For

        End If

        If arrayNumeri(i) > NumeroMax Then

          MsgBox "Intervallo numeri fatture non valido." & vbCrLf & "Il numero " & NumeroMax & " non è ammesso!", _

                 vbExclamation, "Intervallo Numeri Fatture Non Valido"

          VerificaNumeriOk = False

          Exit For

        End If

      Else

        NumI = Left(arrayNumeri(i), InStr(1, arrayNumeri(i), ChrNC) - 1)

        NumF = Right(arrayNumeri(i), Len(arrayNumeri(i)) - InStr(1, arrayNumeri(i), ChrNC))

        If NumI = 0 Then

          MsgBox "Intervallo numeri fatture non valido." & vbCrLf & "Il numero 0 non è ammesso!", _

                 vbExclamation, "Intervallo Numeri Fatture Non Valido"

          VerificaNumeriOk = False

          Exit For

        End If

        If NumF = 0 Then

          MsgBox "Intervallo numeri fatture non valido." & vbCrLf & "Il numero 0 non è ammesso!", _

                 vbExclamation, "Intervallo Numeri Fatture Non Valido"

          VerificaNumeriOk = False

          Exit For

        End If

        If NumI > NumeroMax Then

          MsgBox "Intervallo numeri fatture non valido." & vbCrLf & "Il numero " & NumF & " non è ammesso!", _

                 vbExclamation, "Intervallo Numeri Fatture Non Valido"

          VerificaNumeriOk = False

          Exit For

        End If

        If NumF > NumeroMax Then

          MsgBox "Intervallo numeri fatture non valido." & vbCrLf & "Il numero " & NumF & " non è ammesso!", _

                 vbExclamation, "Intervallo Numeri Fatture Non Valido"

          VerificaNumeriOk = False

          Exit For

        End If

        If NumF < NumI Then

          MsgBox "Intervallo continuativo numeri fatture non valido." & vbCrLf & _

                 "Il numero iniziale (" & NumI & ") non può essere successivo al numero finale (" & NumF & ")!", _

                 vbExclamation, "Intervallo Numeri Fatture Non Valido"

          VerificaNumeriOk = False

          Exit For

        End If

      End If

    Next i

  End With

End Sub

'---

Fai delle prove di inserimento sul file di prova e vedi se il risultato è di tuo gradimento.

ciao

Answer 3

Ciao geacs,

nel tuo quesito non avevi specificato che fossero presenti ANCHE altri fogli oltre agli 80 che avevi indicato come inclusi nella cartella.

Questo è un aspetto molto rilevante e che sarebbe stato bene indicare da subito.

Da quello che dici (le date vengono inserite fino al 70) e se hai provato a inserire la data dal n. 1 al n. 80 dovrebbero esserci 10 fogli che precedono gli 80 dedicati alle fatture.

E' così?

Ci sono anche altri fogli successivi agli 80 dedicati alle fatture?

Inoltre il numero di 80 rimarrà invariato diventando una costante?

Sarebbe il caso tu specificassi nel dettaglio come è strutturata la cartella di lavoro.

ciao

Answer 4

Ciao casanmaner,

Volevo aggiungere che provando e riprovando il codice ho riscontrato che riporta la data fino al foglio70, oltre non scrive nulla. A questo devo aggiungere che ha riportato la data anche sui fogli che precedono il foglio1 e che nel nome dei fogli non viene riportato nessun numero ma dei nomi.

Answer 5

Ciao casanmaner,

Il codice che hai postato è favoloso, perfetto e semplice per il raggiungimento dell'inserimento delle date. Prima di concludere volevo chiederti 2 cose:

1. Avevo dimenticato di dire che i fogli sono protetti per evitare che involontariamente vengano cancellate le formule. Potresti aggiungere al tuo codice la possibilità di proteggere i fogli?
2. Spesso ho letto nei vari thread che vba e celle unite non vanno d'accordo. Visto che in J9 la colonna è stata ristretta e quindi non sufficiente a contenere la data, esiste un modo per aggirare l'ostacolo oppure resto tranquillo che il codice non mi faccia qualche brutto scherzo? Grazie