XL 2010 Contrôles dans USF avant ajout

A

Aldonanou

XLDnaute Junior
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
....
Cliquez pour agrandir...
 
Trier par date Trier par votes
A

Aldonanou

XLDnaute Junior
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
Cliquez pour agrandir...
Merci d'avance.
 
Vote positif 0 Vote négatif
Oneida

Oneida

XLDnaute Impliqué
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
 
Vote positif 0 Vote négatif
A

Aldonanou

XLDnaute Junior
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
Cliquez pour agrandir...
et le msgbox
MsgBox "Veuillez revoir la saisie de la date format JJ/MM/AAAA. Merci "
Cliquez pour agrandir...
Auriez-vous une idée ?

Je vous ai joins un fichier.

Merci
 

Pièces jointes

  • Test Saisie.xlsx
    98.2 KB · Affichages: 8
Vote positif 0 Vote négatif
Oneida

Oneida

XLDnaute Impliqué
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
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 Contrôles Validation Formulaire
2
Réponses
15
Affichages
1 K
mld.sebastien
M
chaelie2015
  • Résolu(e)
Autres (RESOLU) Restaurer la couleur d'origine
Réponses
4
Affichages
515
chaelie2015
chaelie2015
Messan
  • Résolu(e)
XL 2019 Organiser les données dans listbox
Réponses
2
Affichages
690
Messan
Messan
Y
  • Question
XL 2019 Copie des données des différentes lignes sur une base de données
Réponses
10
Affichages
1 K
YANNISE
Y
Y
  • Résolu(e)
XL 2016 Transfère des données réparties sur des lignes à une base de données
Réponses
12
Affichages
2 K
soan
S
D
  • Question
Microsoft 365 Modification d'un code VBA
Réponses
8
Affichages
881
Hasco
Hasco
B
  • Question
XL 2019 bug dans l'enregistrement (VBA)
Réponses
9
Affichages
2 K
bluesky12000
B
F
  • Question
re-Modification à partir d'une ComboBox dans un tableau dynamique
Réponses
9
Affichages
4 K
Staple1600
Staple1600
N
  • Question
XL 2010 Erreur 1004, definie par l'application ou l'objet, dans une boucle
Réponses
5
Affichages
2 K
Nicko29
N
Ilino
  • Question
[RESOLU]Limiter l'ajout des donnees dans un tableau via usf
Réponses
3
Affichages
791
Ilino
Ilino

Membres actuellement en ligne

12 membres et 149 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 098
Messages
2 116 193
Membres
112 679
dernier inscrit
Yupanki