XL 2010 Contrôles dans USF avant ajout

Aldonanou · 13 Février 2023

Bonjour,

J’ai réalisé pour la gestion d’un snack réservé aux employés un formulaire de saisie. Toutefois, il s’avère qu’il peut y avoir des personnes externes à l’entreprise qui passent commande. Je voudrais mettre un contrôle lors de la validation de la saisie sur "PersonnelLPCH" ou sur "TxtBoxInviteNom" en fonction du cas, soit la textbox personnelLPCH est complétée soit la txtboxInvitenom est complétée et cela valide l'enregistrement. Mais je n'y arrive pas.

Quelqu'un aurait-il une idée.

Merci d'avance

Private Sub ajouter_Click()

' Coloration des Labels en noir (&H80000012 = couleur de base de la propriété ForeColor)
Label_PersonnelLPCH.ForeColor = &H80000012
LabelInvité.ForeColor = &H80000012
TextBoxInviteAdresse.ForeColor = &H80000012
Label_NumQuittancier.ForeColor = &H80000012
Label_DateSaisie.ForeColor = &H80000012

' Contrôles des champs
If PersonnelLPCH = "" Then ' si absence de nom du personnel LPCH
'Label_PersonnelLPCH.ForeColor = RGB(255, 0, 0)
'intpout = MsgBox("Information à sélectionner", vbInformation, "")

ElseIf TextNumQuittancier = "" Then 'Si absence de numéro de quittancier
Label_NumQuittancier.ForeColor = RGB(255, 0, 0)
intpout = MsgBox("Information à saisir", vbInformation, "")

ElseIf TextDateSaisie = "" Then 'Si absence de date inscrite sur quittancier
Label_DateSaisie.ForeColor = RGB(255, 0, 0)
intpout = MsgBox("Information à compléter", vbInformation, "")
Else

If CheckBox2 = True And TextBoxInviteNom = "" Then 'si absence de nom d'invité
LabelInvité.ForeColor = RGB(255, 0, 0)
intpout = MsgBox("Information à compléter", vbInformation, "")

ElseIf TextNumQuittancier = "" Then 'Si absence de numéro de quittancier
Label_NumQuittancier.ForeColor = RGB(255, 0, 0)
intpout = MsgBox("Information à saisir", vbInformation, "")

ElseIf TextDateSaisie = "" Then 'Si absence de date inscrite sur quittancier
Label_DateSaisie.ForeColor = RGB(255, 0, 0)
intpout = MsgBox("Information à compléter", vbInformation, "")

Else
If PersonnelLPCH = "" And txtboxInvitenom <> "" And TextNumQuittancier = "" And TextDateSaisie = "" Then 'données vides
MsgBox "Le formulaire est incomplet (en rouge) , il ne sera pas enregistré !" '
'Exit Sub
Else
While Sheets("SaisieQuittancier").Cells(Ligne, 2).Value <> ""
Ligne = Ligne + 1
Wend

Sheets("SaisieQuittancier").Cells(Ligne, 1) = CDate(TextDate)
Sheets("SaisieQuittancier").Cells(Ligne, 2) = CDbl(TextBoxNum)
Sheets("SaisieQuittancier").Cells(Ligne, 3) = TextNumQuittancier
....

Oneida · 14 Février 2023

Bonjour,
le code de votre procedure n'est pas complet.

Aldonanou · 14 Février 2023

Bonjour, en fait pour ne pas inonder la demande, j'ai joint l'intégralité du développement.

Voilà le code en intégralité.

Private Sub ajouter_Click()

Set f = Sheets("SaisieQuittancier")

For I = 1 To 2
If Me.Controls("Checkbox" & I) = True Then
'code si case cochee
Else
'code si case pas cochee
End If
Next I

' Oui
Dim reponse1 As Integer
If SaisieQuittancier.CheckBox1.Value = True Then
reponse1 = 1
Else
reponse1 = 0
End If

' Non
Dim reponse2 As Integer
If SaisieQuittancier.CheckBox2.Value = True Then
reponse2 = 1
Else
reponse2 = 0
End If

' Coloration des Labels en noir (&H80000012 = couleur de base de la propriété ForeColor)
Label_PersonnelLPCH.ForeColor = &H80000012
LabelInvité.ForeColor = &H80000012
TextBoxInviteAdresse.ForeColor = &H80000012
Label_NumQuittancier.ForeColor = &H80000012
Label_DateSaisie.ForeColor = &H80000012

' Contrôles des champs
If CheckBox1 = True And PersonnelLPCH = "" Then ' si absence de nom du personnel LPCH
Label_PersonnelLPCH.ForeColor = RGB(255, 0, 0)
intpout = MsgBox("Information à sélectionner", vbInformation, "")

ElseIf TextNumQuittancier = "" Then 'Si absence de numéro de quittancier
Label_NumQuittancier.ForeColor = RGB(255, 0, 0)
intpout = MsgBox("Information à saisir", vbInformation, "")

ElseIf TextDateSaisie = "" Then 'Si absence de date inscrite sur quittancier
Label_DateSaisie.ForeColor = RGB(255, 0, 0)
intpout = MsgBox("Information à compléter", vbInformation, "")
Else

If CheckBox2 = True And TextBoxInviteNom = "" Then 'si absence de nom d'invité
LabelInvité.ForeColor = RGB(255, 0, 0)
intpout = MsgBox("Information à compléter", vbInformation, "")

ElseIf TextNumQuittancier = "" Then 'Si absence de numéro de quittancier
Label_NumQuittancier.ForeColor = RGB(255, 0, 0)
intpout = MsgBox("Information à saisir", vbInformation, "")

ElseIf TextDateSaisie = "" Then 'Si absence de date inscrite sur quittancier
Label_DateSaisie.ForeColor = RGB(255, 0, 0)
intpout = MsgBox("Information à compléter", vbInformation, "")
Else

'Dim SaisieQuittancier As String

Sheets("SaisieQuittancier").Activate
ActiveSheet.Visible = True
ActiveSheet.Select

Dim Response As Byte
Dim Ligne As Integer: Ligne = 2
'ligne = Cells(Rows.Count, 1).End(xlUp).Row + 1

If PersonnelLPCH = "" And txtboxInvitenom <> "" And TextNumQuittancier = "" And TextDateSaisie = "" Then 'données vides
MsgBox "Le formulaire est incomplet (en rouge) , il ne sera pas enregistré !" ' plus besoin de message car contrôles préalables
'Exit Sub

'*************
If IsDate(TextDateSaisie.Text) And TextDateSaisie.Text Like "##/##/####" Then
'msgbox "c'est ok"
Else
MsgBox "Veuillez revoir la saisie de la date format JJ/MM/AAAA. Merci "
End If
'**************

Else ' cas contraire

While Sheets("SaisieQuittancier").Cells(Ligne, 2).Value <> ""
Ligne = Ligne + 1
Wend

Sheets("SaisieQuittancier").Cells(Ligne, 1) = CDate(TextDate)
Sheets("SaisieQuittancier").Cells(Ligne, 2) = CDbl(TextBoxNum)
Sheets("SaisieQuittancier").Cells(Ligne, 3) = TextNumQuittancier
Sheets("SaisieQuittancier").Cells(Ligne, 4) = PersonnelLPCH
Sheets("SaisieQuittancier").Cells(Ligne, 5) = TextDateSaisie
Sheets("SaisieQuittancier").Cells(Ligne, 7) = TextValeurPlat1
Sheets("SaisieQuittancier").Cells(Ligne, 8) = TextPlat1
Sheets("SaisieQuittancier").Cells(Ligne, 9) = NbreRepas1
Sheets("SaisieQuittancier").Cells(Ligne, 10) = PrixUnitaire1
Sheets("SaisieQuittancier").Cells(Ligne, 11) = TotalPlat1
Sheets("SaisieQuittancier").Cells(Ligne, 12) = TextValeurPlat2
Sheets("SaisieQuittancier").Cells(Ligne, 13) = TextPlat2
Sheets("SaisieQuittancier").Cells(Ligne, 14) = NbreRepas2
Sheets("SaisieQuittancier").Cells(Ligne, 15) = PrixUnitaire2
Sheets("SaisieQuittancier").Cells(Ligne, 16) = TotalPlat2
Sheets("SaisieQuittancier").Cells(Ligne, 17) = TextValeurPlat3
Sheets("SaisieQuittancier").Cells(Ligne, 18) = TextPlat3
Sheets("SaisieQuittancier").Cells(Ligne, 19) = NbreRepas3
Sheets("SaisieQuittancier").Cells(Ligne, 20) = PrixUnitaire3
Sheets("SaisieQuittancier").Cells(Ligne, 21) = TotalPlat3
Sheets("SaisieQuittancier").Cells(Ligne, 22) = TextValeurPlat4
Sheets("SaisieQuittancier").Cells(Ligne, 23) = TextPlat4
Sheets("SaisieQuittancier").Cells(Ligne, 24) = NbreRepas4
Sheets("SaisieQuittancier").Cells(Ligne, 25) = PrixUnitaire4
Sheets("SaisieQuittancier").Cells(Ligne, 26) = TotalPlat4
Sheets("SaisieQuittancier").Cells(Ligne, 27) = TextValeurPlat5
Sheets("SaisieQuittancier").Cells(Ligne, 28) = TextPlat5
Sheets("SaisieQuittancier").Cells(Ligne, 29) = NbreRepas5
Sheets("SaisieQuittancier").Cells(Ligne, 30) = PrixUnitaire5
Sheets("SaisieQuittancier").Cells(Ligne, 31) = TotalPlat5
Sheets("SaisieQuittancier").Cells(Ligne, 32) = TextBoxInviteNom
Sheets("SaisieQuittancier").Cells(Ligne, 33) = TextBoxInviteAdresse
End If

End If

End If

' SI OUI ALORS LPCH

' ActiveSheet.Visible = False
' à remettre ensuite après test

' Vide les données puis affiche l'UserForm
Unload Me
Application.DisplayAlerts = False
ActiveWorkbook.Save

ActiveSheet.Visible = True 'False si nécessité de faire disparaître

Application.DisplayAlerts = True
SaisieQuittancier.Show

End Sub

Merci d'avance.

Oneida · 15 Février 2023

Bonjour,
A vous de tester vu que je ne peux p

VB:

Private Sub ajouter_Click()
    Dim Response As Byte
    Dim Ligne As Long
    ' Coloration des Labels en noir (&H80000012 = couleur de base de la propriété ForeColor)
    Label_PersonnelLPCH.ForeColor = &H80000012
    LabelInvité.ForeColor = &H80000012
    TextBoxInviteAdresse.ForeColor = &H80000012
    Label_NumQuittancier.ForeColor = &H80000012
    Label_DateSaisie.ForeColor = &H80000012

    ' Contrôles des champs
    If CheckBox1 = True And PersonnelLPCH = "" Then ' si absence de nom du personnel LPCH
        Label_PersonnelLPCH.ForeColor = RGB(255, 0, 0)
        intpout = MsgBox("Information à sélectionner", vbInformation, "")
        PersonnelLPCH.SetFocus
        Exit Sub
    ElseIf TextNumQuittancier = "" Then 'Si absence de numéro de quittancier
        Label_NumQuittancier.ForeColor = RGB(255, 0, 0)
        intpout = MsgBox("Information à saisir", vbInformation, "")
        TextNumQuittancier.SetFocus
        Exit Sub
    ElseIf TextDateSaisie = "" Then 'Si absence de date inscrite sur quittancier
        Label_DateSaisie.ForeColor = RGB(255, 0, 0)
        intpout = MsgBox("Information à compléter", vbInformation, "")
        TextDateSaisie.SetFocus
        Exit Sub
    ElseIf CheckBox2 = True And TextBoxInviteNom = "" Then 'si absence de nom d'invité
            LabelInvité.ForeColor = RGB(255, 0, 0)
            intpout = MsgBox("Information à compléter", vbInformation, "")
            TextBoxInviteNom.SetFocus
            Exit Sub
    ElseIf IsDate(TextDateSaisie.Text) And TextDateSaisie.Text Like "##/##/####" Then
        With Sheets("SaisieQuittancier")
            Ligne = .Range("B" & .Rows.Count).End(xlUp).Row + 1
            .Cells(Ligne, 1) = CDate(TextDate)
            .Cells(Ligne, 2) = CDbl(TextBoxNum)
            .Cells(Ligne, 3) = TextNumQuittancier
            .Cells(Ligne, 4) = PersonnelLPCH
            .Cells(Ligne, 5) = TextDateSaisie
            .Cells(Ligne, 7) = TextValeurPlat1
            .Cells(Ligne, 8) = TextPlat1
            .Cells(Ligne, 9) = NbreRepas1
            .Cells(Ligne, 10) = PrixUnitaire1
            .Cells(Ligne, 11) = TotalPlat1
            .Cells(Ligne, 12) = TextValeurPlat2
            .Cells(Ligne, 13) = TextPlat2
            .Cells(Ligne, 14) = NbreRepas2
            .Cells(Ligne, 15) = PrixUnitaire2
            .Cells(Ligne, 16) = TotalPlat2
            .Cells(Ligne, 17) = TextValeurPlat3
            .Cells(Ligne, 18) = TextPlat3
            .Cells(Ligne, 19) = NbreRepas3
            .Cells(Ligne, 20) = PrixUnitaire3
            .Cells(Ligne, 21) = TotalPlat3
            .Cells(Ligne, 22) = TextValeurPlat4
            .Cells(Ligne, 23) = TextPlat4
            .Cells(Ligne, 24) = NbreRepas4
            .Cells(Ligne, 25) = PrixUnitaire4
            .Cells(Ligne, 26) = TotalPlat4
            .Cells(Ligne, 27) = TextValeurPlat5
            .Cells(Ligne, 28) = TextPlat5
            .Cells(Ligne, 29) = NbreRepas5
            .Cells(Ligne, 30) = PrixUnitaire5
            .Cells(Ligne, 31) = TotalPlat5
            .Cells(Ligne, 32) = TextBoxInviteNom
            .Cells(Ligne, 33) = TextBoxInviteAdresse
        End With
        MsgBox "Veuillez revoir la saisie de la date format JJ/MM/AAAA. Merci "
        TextDateSaisie.SetFocus
        Exit Sub
    End If

    ' SI OUI ALORS LPCH
    
    ' ActiveSheet.Visible = False
    ' à remettre ensuite après test
    
    
    ' Vide les données puis affiche l'UserForm
    Unload Me
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Application.DisplayAlerts = True
    'ActiveSheet.Visible = True 'False si nécessité de faire disparaître
    SaisieQuittancier.Show
End Sub

as le faire

Aldonanou · 15 Février 2023

Bonjour Oneida,

merci de votre retour. Génial, cela fonctionne. Toutefois, il semblerait que même si la date est saisie correctement elle n'est pas reconnue comme t'elle. Je voulais rajouter un contrôle afin de m'assurer que la date était conforme car in fine cela doit générer des factures. En attendant, j'ai désactivé la partie :

ElseIf IsDate(TextDateSaisie.Text) And TextDateSaisie.Text Like "##/##/####" Then

et le msgbox

MsgBox "Veuillez revoir la saisie de la date format JJ/MM/AAAA. Merci "

Auriez-vous une idée ?

Je vous ai joins un fichier.

Merci

Oneida · 16 Février 2023

Bonjour,

elle n'est pas reconnue comme t'elle.
Fan de Kaamelott (Perceval)?
Je regarde la chose

Suite:
Ce code est de PatrickToulon de ExcelDownload
Fichier avec masque saisie date FR
Le code est mettre dans l'UF. Pensez a adapter le nom de la TextBox
De ce fait vous n'avez qu'a controler si la TextBox est vide
De c

XL 2010 Contrôles dans USF avant ajout

Aldonanou

XLDnaute Junior

Oneida

XLDnaute Impliqué

Aldonanou

XLDnaute Junior

Oneida

XLDnaute Impliqué

Aldonanou

XLDnaute Junior

Pièces jointes

Oneida

XLDnaute Impliqué

Discussions similaires