Controllo date ed orari su userform

[danybo]

Buongiorno a tutti,

ho un problemino: da una userform alcuni utenti mi inseriscono data ed
orario (dalle-alle) per prenotare una sala riunioni; i campi sono così
suddivisi:

data: TextBox1
dalle ore: TextBox2
alle ore: TextBox4

Vorrei i seguenti controlli prima che la macro mi metta tutto sul
foglio:
1- non sia possibile inserire una data nel passato rispetto alla data
odierna
2- non sia possibile mettere un orario superiore in "alle" ripetto
"dalle"
(tipo riunione dalle 16:00 alle 15:00 impossibile)

Mi potete aiutare?
Grazie mille,
ciao, daniele

[danybo]

Ho dimenticato di dire che il formato degli orari che immetto è con il
punto
10.00 11.30 12.56 ecc...

[r]

il controllo degli orari viene eseguito dopo l'uscita dalla
textbox3 ...
questo vuol dire che se inserisci gli orari correttamente poi
modifichi
la textbox2 ... il controllo non viene rifatto.
io preferisco sempre nelle form evitare msgbox che segnalano errori

La soluzione che propongo necessita dell'aggiunta di una Label1
che segnala gli errori ... quindi se vuoi provare prima di usare il
codice nella tua form ... crea una nuova form aggiungi una label
e 3 textbox nel modulo della form incolli tutta questa pappardella

oltre ai controlli che hai imposto all'uscita delle textbox viene
verificata
la correttezza del dato inserito ... la data in formato europeo e gli
orari con il .

saluti
r

Option Explicit
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'per l'esempio:
'UserForm1 contenente
'Label1
'TextBox1
'TextBox2
'TextBox3
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'altri path si trovano qui:

Private Sub UserForm_Initialize()
With Me
.Caption = "Esempi TextBox con convalida"
.Label1.Caption = ""
.Label1.ForeColor = &HFF&
.TextBox1.Tag = "Data Europea"
.TextBox2.Tag = "Orario Dalle"
.TextBox3.Tag = "Orario Dalle"
End With
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'data europea
UserForm_Controllo_Event_Exit Me.Label1, _
Me.TextBox1, _
Cancel, _
"^(3[01]|[12]\d|0?[1-9])/(0?[13578]|10|12)/" & _
"(\d{2}|(19|20|21)\d{2})$" & _
"|^(30|[12]\d|0?[1-9])/(0?[469]|11)/(\d{2}|" & _
"(19|20|21)\d{2})$" & _
"|^(2[0-8]|[01]\d|0?[1-9])/(0?2)/(\d{2}|" & _
"(19|20|21)\d{2})$" & _
"|^29/(0?2)/(2000|00)$" & _
"|^29/(0?2)/(19|20|21)?(0[48]|[2468][048]|" & _
"[13579][26])$"

UserForm_Controllo_Data Me.Label1, _
Me.TextBox1, _
Cancel, _
CDate(Me.TextBox1.Text)
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'codice fiscale
UserForm_Controllo_Event_Exit Me.Label1, _
Me.TextBox2, _
Cancel, _
"^(0?[0-9]|1\d|2[0-3])\.[0-5]\d$"
End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'numero a virgola mobile
UserForm_Controllo_Event_Exit Me.Label1, _
Me.TextBox3, _
Cancel, _
"^(0?[0-9]|1\d|2[0-3])\.[0-5]\d$"

UserForm_Controllo_Orari Me.Label1, _
Me.TextBox3, _
Cancel, _
CDate(Me.TextBox2.Text), _
CDate(Me.TextBox3.Text)

End Sub

Sub UserForm_Controllo_Event_Exit( _
ByRef oLabel As MSForms.Label, _
ByRef oControl As MSForms.Control, _
ByRef Cancel As MSForms.ReturnBoolean, _
Optional ByVal sPattern As String = "[\w\s]+")
'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Di Roberto Mensa nick r
'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Effettua un controllo sul testo digitato in un
'controllo, se il controllo ha esito negativo
'ripassa cancel=true impedendo l'uscita del focus
'e seleziona l'intero testo digitato
'da richiamare dall'evento exit di controlli che
'hanno cancel come argomento
'oLabel è il controllo Label entro cui comunicare
'il messaggio di errore

Dim re As Object
Static sLabelCaption As String
Static bCancel As Boolean

If bCancel = False Then
sLabelCaption = oLabel.Caption
End If

Set re = CreateObject("vbscript.regexp")
re.Pattern = sPattern
re.ignorecase = True
With oControl
If Len(.Text) > 0 Then
If re.test(.Text) = False Then
oLabel.Caption = _
"Testo " & .Tag & " - Non valido!"
.SelStart = 0
.SelLength = Len(.Text)
Cancel = True
bCancel = True
End If
End If
End With
If Cancel = False Then
bCancel = False
oLabel.Caption = sLabelCaption
End If
End Sub

Sub UserForm_Controllo_Orari( _
ByRef oLabel As MSForms.Label, _
ByRef oControl As MSForms.Control, _
ByRef Cancel As MSForms.ReturnBoolean, _
ByVal dOrarioDa As Date, _
ByVal dOrarioA As Date)

Static sLabelCaption As String
Static bCancel As Boolean

If bCancel = False Then
sLabelCaption = oLabel.Caption
End If

With oControl
If Len(.Text) > 0 Then
If dOrarioA < dOrarioDa Then
oLabel.Caption = _
"Valore " & .Tag & " - Non valido!"
.SelStart = 0
.SelLength = Len(.Text)
Cancel = True
bCancel = True
End If
End If
End With
If Cancel = False Then
bCancel = False
oLabel.Caption = sLabelCaption
End If
End Sub

Sub UserForm_Controllo_Data( _
ByRef oLabel As MSForms.Label, _
ByRef oControl As MSForms.Control, _
ByRef Cancel As MSForms.ReturnBoolean, _
ByVal dData As Date)

Static sLabelCaption As String
Static bCancel As Boolean

If bCancel = False Then
sLabelCaption = oLabel.Caption
End If

With oControl
If Len(.Text) > 0 Then
If dData < Date Then
oLabel.Caption = _
"Valore " & .Tag & " - Non valido!"
.SelStart = 0
.SelLength = Len(.Text)
Cancel = True
bCancel = True
End If
End If
End With
If Cancel = False Then
bCancel = False
oLabel.Caption = sLabelCaption
End If
End Sub

[r]

meglio così ... riposto tutto per comodità nell'incollare
saluti
r

If Cancel = True Then Exit Sub

UserForm_Controllo_Data Me.Label1, _
Me.TextBox1, _
Cancel, _
CDate(Me.TextBox1.Text)
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'codice fiscale
UserForm_Controllo_Event_Exit Me.Label1, _
Me.TextBox2, _
Cancel, _
"^(0?[0-9]|1\d|2[0-3])\.[0-5]\d$"
End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'numero a virgola mobile
UserForm_Controllo_Event_Exit Me.Label1, _
Me.TextBox3, _
Cancel, _
"^(0?[0-9]|1\d|2[0-3])\.[0-5]\d$"

If Cancel = True Then Exit Sub

[danybo]

Grazie r,

> .TextBox2.Tag = "Orario Dalle"
> .TextBox3.Tag = "Orario Alle" <--- devo modificare?

Mi potresti per favore inviare un file di esempio?
Ciaooo, daniele

[r]

fatto ...
il file comunque è scaricabile da questa pagina:
https://sites.google.com/site/e90e50/scambio-file
ho dovuto fare ancora alcune modifiche ... la fretta
saluti
r

[danybo]

> il file comunque è scaricabile da questa pagina:https://sites.google.com/site/e90e50/scambio-file
> ho dovuto fare ancora alcune modifiche ... la fretta

Ho scaricato ora anche il nuovo file e riproverò l'integrazione con il
mio...
Ti ho comunque inviato il file che uso poichè ho alcune difficoltà con
le variabili
per integrare il tuo lavoro che autonomamente funziona perfettamente,
ma che
non riesco ad associare al mio file... G r a z i e !