Inexécution d'une commande [Résolu/Fermé]

Signaler
Messages postés
29
Date d'inscription
lundi 25 mai 2015
Statut
Membre
Dernière intervention
22 novembre 2020
-
Messages postés
29
Date d'inscription
lundi 25 mai 2015
Statut
Membre
Dernière intervention
22 novembre 2020
-
Bonjour,

Merci de m'aider,
j'ai un problème dans ma VBA je n'arrive pas a comprendre pourquoi la commande de détection des doublons ne marche pas.

https://www.cjoint.com/c/FFEi7aDoKdR

Bonne journée

1 réponse

Messages postés
1412
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
9 mars 2021
152
Bonjour Kojko, bonjour le forum,

Ta comparaison entre cellule et contrôle (TextBox, ComboBox) est périlleuse car il faut tenir compte des formats de nombres et de dates de la caisse (majuscule/minuscule). il suffit d'une seule différence et la condition de doublons n'est pas avérée.
J'ai réécrit une partie du code en le simplifiant et en utilisant les bons formats.
J'ai noté en commentaires, tu verras, ce qui me semblait être des anomalies dans ton code d'origine que j'ai revisité.
J'ai bloqué l'édition des texboxes 5 et 6 (les valeurs) pour limiter aux seules valeurs numériques.

je n'ai trouvé ni le CommandButon3 ni le CommandButton4. J'ai donc supprimé cette partie du code...

Le code de l'UserForm :

Private Sub UserForm_Initialize()
ComboBox2.AddItem ("Médicaments(Vignettes Vertes)") '0
ComboBox2.AddItem ("Médicaments(Vignettes Rouges)") '1
ComboBox2.AddItem ("Consultation Généraliste") '2
ComboBox2.AddItem ("Consultation Spécialiste") '3
ComboBox2.AddItem ("Consultation Professeur") '4
ComboBox2.AddItem ("Consultation Sage femmme") '5
ComboBox2.AddItem ("Acte en K") '6
ComboBox2.AddItem ("Verre") '7
ComboBox2.AddItem ("Monture") '8
ComboBox2.AddItem ("Lentilles") '9
ComboBox2.AddItem ("Analyse") '10
ComboBox2.AddItem ("Radiographie") '11
ComboBox2.AddItem ("Hospitalisation") '12
ComboBox2.AddItem ("Soins dentaires") '13
ComboBox2.AddItem ("Chirurgie dentaire") '14
ComboBox2.AddItem ("Prothese dentaire") '15
ComboBox2.AddItem ("Echographie de grossesse") '16
ComboBox2.AddItem ("Accouchement sans complication") '17
ComboBox2.AddItem ("Accouchement avec complication") '18
ComboBox2.AddItem ("Cures thermales") '19
ComboBox2.AddItem ("Sanatorium Préventorium") '20
ComboBox2.AddItem ("Protheses auditives et Orthopediques") '21
ComboBox2.AddItem ("Transport du malade en algerie") '22
ComboBox2.AddItem ("Transport du malade à l'etranger") '23
Label8 = Range("L9")
If Label8 > 98000 Then MsgBox ("Veuillez valider le bordereau")
End Sub

Private Sub TextBox5_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'à l'appui sur une touche dans la Textbox5
If KeyAscii = 46 Then KeyAscii = 44: Exit Sub 'si la touche appuyée est le point, remplace le point par une virgule, sort de la procédure
If KeyAscii = 44 Then Exit Sub 'si la touche appuyée est une virgule,sort de la procédure
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 8 'si la touche appuyée est tout autre touche que {0, 1, 2, 3, 4, 5, 6, 7, 8 ou 9}, efface le caractère
End Sub

Private Sub TextBox6_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 46 Then KeyAscii = 44: Exit Sub
If KeyAscii = 44 Then Exit Sub
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 8
End Sub

Private Sub CommandButton1_Click()
'bouton pour la validation de la saisie
Dim derligne As Integer
Dim VF As Double 'déclare la variable VF (Valeur Frais)
Dim VR As Double 'déclare la variable VR (Valeur Remboursement)

derligne = Sheets("données").Range("A4565").End(xlUp).Row + 1
'pour signaler l'existance des doublons et arrêter le processus
 For I = 11 To derligne - 1
    If UCase(Cells(I, 1).Value) = UCase(Me.TextBox1.Value) Then
        If UCase(Cells(I, 2).Value) = UCase(Me.TextBox2.Value) Then
            If Cells(I, 3).Value = Me.ComboBox2.Value Then
                If CDate(Cells(I, 4).Value) = CDate(Me.TextBox4.Value) Then
                    If CDbl(Cells(I, 5).Value) = CDbl(Me.TextBox5.Value) Then
                        If CDbl(Cells(I, 6).Value) = CDbl(Me.TextBox6.Value) Then
                            MsgBox "veuillez recommencer car cette donnée existe déjà"
                            Exit Sub
                        End If
                    End If
                End If
            End If
        End If
    End If
Next I
If Me.TextBox5.Value = "" Then VF = 0 Else VF = CDbl(Me.TextBox5.Value) 'définit la variable VF
If Me.TextBox6.Value = "" Then VR = 0 Else VR = CDbl(Me.TextBox6.Value) 'définit la variable VR
Select Case Me.ComboBox2.ListIndex 'action en fontion du numéro d'index de l'élément sélectionné dans la ComboBox2
    Case 0, 19, 20 'Médicaments(Vignettes Vertes & Cures thermales & Sanatorium Préventorium
        Cells(derligne, 7) = VR * 0.25
    Case 1 'Médicaments(Vignettes Rouges
        Cells(derligne, 7).Value = IIf(VF > 10000, 5000, VR * 0.5) 'tu as mis (VF-VF > 10000) c'est impossible ça fera toujours zéro ! puis tu as mis (VF * 0.5) - à vérifier
    Case 3 'Consultation Spécialiste
        Cells(derligne, 7).Value = IIf(VF > 100, 600, VR * 0.25)
    Case 4 'Consultation Professeur
        Cells(derligne, 7).Value = IIf(VF > 100, 700, VR * 0.25)
    Case 5 'Consultation Professeur
        Cells(derligne, 7).Value = IIf(VF > 50, 200, VR * 0.25)
    Case 6 'Acte en K
        Cells(derligne, 7).Value = IIf(VF > 2000, 2000, VF - VR)
    Case 10 'Analyse
        Cells(derligne, 7).Value = IIf(VF > 6000, 6000, VF - VR) 'tu n'as pas mis la seconde condition si VF<=6000 !
    Case 11 'Radiographie
        Cells(derligne, 7).Value = IIf(VF > 900, 900, VF - VR)
    Case 2 'Consultation généraliste
        Cells(derligne, 7).Value = IIf(VF > 100, 400, VR * 0.25)
    Case 7 'verre
        Cells(derligne, 7).Value = IIf(VF - VF > 6000, 6000, VF - VR)
    Case 8 'monture
        Cells(derligne, 7).Value = IIf(VF - VF > 2500, 2500, VF - VR)
    Case 9, 15, 22 'Lentilles & Prothese dentaire & transport du malade en Algérie
        Cells(derligne, 7).Value = IIf(VF - VF > 5000, 5000, VF - VR)
    Case 13, 14, 16 'Soins dentaires & chirurgie dentaire & Echographie de grossesse
        Cells(derligne, 7).Value = IIf(VF - VF > 1500, 1500, VF - VR)
    Case 17 'Accouchement sans complication
        Cells(derligne, 7).Value = IIf(VF - VF > 20000, 20000, VF - VR)
    Case 12, 18 'Accouchement avec complication
        Cells(derligne, 7).Value = IIf(VF - VF > 30000, 30000, VF - VR)
    Case 23 'Transport du malade à l'étranger
        Cells(derligne, 7).Value = VF - VR
    Case 21 'Prothèses auditives et Orthopédiques
        Cells(derligne, 7).Value = IIf(VF - VF > 4000, 4000, VF - VR)
End Select
If MsgBox("confirmez-vous l'ajout des données?", vbYesNo, "confirmation") = vbYes Then
    Cells(derligne, 1) = TextBox1.Value
    Cells(derligne, 2) = TextBox2.Value
    Cells(derligne, 3) = ComboBox2.Value
    Cells(derligne, 4) = Format(TextBox4.Value, "yyyy/mm/dd")
    Cells(derligne, 5) = VF
    Cells(derligne, 6) = VR
    Label8 = Range("L9")
    If Label8 > 98000 Then MsgBox ("Veuillez valider le bordereau")
End If
TextBox1.Value = ""
TextBox2.Value = ""
ComboBox2.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
Me.TextBox1.SetFocus
End Sub

Private Sub CommandButton2_Click()
Unload UserForm1
End Sub


Messages postés
29
Date d'inscription
lundi 25 mai 2015
Statut
Membre
Dernière intervention
22 novembre 2020

Bonjour

je vous remercie infiniment pour votre aide.

cordialement.