Inexécution d'une commande

Résolu
kojko Messages postés 33 Statut Membre -  
kojko Messages postés 33 Statut Membre -
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

  1. ThauTheme Messages postés 1564 Statut Membre 160
     
    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
    


    0
    1. kojko Messages postés 33 Statut Membre
       
      Bonjour

      je vous remercie infiniment pour votre aide.

      cordialement.
      0