Microsoft 365 Assistance pour correction Macro

Muzzik · 8 Avril 2021

Bonjour a tous
j'en appel aux experts VBA, j'ai grâce a différents tuto construit un fichier pour gérer une base de contact.
Ce fichier comporte un formulaire pour saisie de nouveaux contact, modification de contact existant, et bien sur suppression.
j'ai un bug que je n'arrive pas a corriger car a l'ajout de nouveau patient en logique je devrais ajouter celui ci dans mon tableau à partir de la ligne 22, mais la il me positionne cela en ligne 23 et va même me supprimer des contact déjà présent???
Je vous joins ci dessous la version sans données, car celle ci sont confidentiel

Si quelqu'un pouvait m'aider a comprendre mon erreur ce serait sympa. Merci d'avance a ceux qui prendront du temps pour m'accompagner.
Prenez soin de vous
Merci

pierrejean · 8 Avril 2021

Bonjour Muzzik
Revois la fonction avec 2 au lieu de 1 (colonne B et non colonne A)

VB:

Function NvLigne()
Dim ligne As Integer

ligne = 22

Do While Cells(ligne,2).Value <> ""
    ligne = ligne + 1
    If (ligne > 1000) Then Exit Do
Loop

NvLigne = ligne


End Function

Muzzik · 8 Avril 2021

Bonjour Pierrejean
Merci pour ta réponse effectivement, je modifie ce point, par contre j'ai toujours le même soucis, je m'explique, dans la logique à partir de la ligne 22 si la création n'existe pas déja, je devrai décaler d'une ligne pour inserer l'ajout, la il m'écrase l'existant.
Je ne sais pas si cela peut répondre a cela mais après avoir réalisé les différents test j'ai par le biais d'un copier/coller insérer dans la BDD a partir de la ligne 22 environ 500 contacts. cela aurait il pu avoir une incidence, créer un décalage dans le bon fonctionnement de la macro.
Quoi qu'il en soit cette base n'est pas destiné a héberger plus de 600/700 max contacts

Code:

Private Sub insertion(mode As String)
Dim ligne As Integer: Dim test As Boolean

test = False
If (Range("P9").Value >= 0) Then 'vérifie si tous les champs sont bien a o et non pas Nok, cette verification se fait sur la cellule P9 dans cet exemple'
    If (mode = "Ajout") Then
    ligne = NvLigne
    If (ClExiste = True) Then test = True
Else
    ligne = lignesel
End If

    ActiveSheet.Unprotect 'supprime la protection de le feuille active'
    If test = False Then
    Range("B" & ligne).Value = Range("B3").Value 'fonction qui permet de récupérer dans l'exemple les informations de la Colonne B et de les transposer dans le formulaire affichage B=>B3'
    Range("C" & ligne).Value = Range("D3").Value 'fonction qui permet de récupérer dans l'exemple les informations de la Colonne C et de les transposer dans le formulaire affichage C=>D3'
    Range("D" & ligne).Value = Range("G3").Value 'fonction qui permet de récupérer dans l'exemple les informations de la Colonne D et de les transposer dans le formulaire affichage D=>G3'
    Range("E" & ligne).Value = Range("B6").Value 'fonction qui permet de récupérer dans l'exemple les informations de la Colonne E et de les transposer dans le formulaire affichage E=>B6'
    Range("F" & ligne).Value = Range("D6").Value 'fonction qui permet de récupérer dans l'exemple les informations de la Colonne E et de les transposer dans le formulaire affichage F=>D6'
    Range("G" & ligne).Value = Range("B9").Value 'fonction qui permet de récupérer dans l'exemple les informations de la Colonne G et de les transposer dans le formulaire affichage G=>B9'
    Range("H" & ligne).Value = Range("G9").Value 'fonction qui permet de récupérer dans l'exemple les informations de la Colonne H et de les transposer dans le formulaire affichage H=>G9'
    Range("I" & ligne).Value = Range("D9").Value 'fonction qui permet de récupérer dans l'exemple les informations de la Colonne I et de les transposer dans le formulaire affichage I=>D9'
    
Else
    MsgBox "le patient est déja inscrit dans la Base" 'message a modifier en fonction des attentes'
End If

    vider_form  'procédure pour vider le formulaire et démarrer un nouvel enregistrement'
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
    
Else

    MsgBox "Tous les champs ne sont pas complétés" 'message a modifier en fonction des attentes'

End If

End Sub

Code:

Function NvLigne()
Dim ligne As Integer

ligne = 22

Do While Cells(ligne, 2).Value <> ""
    ligne = ligne + 1
    If (ligne > 10000) Then Exit Do
Loop

NvLigne = ligne


End Function

Function ClExiste() As Boolean
Dim ligne As Integer

ligne = 22: ClExiste = False

Do While Cells(ligne, 2).Value <> ""

    If (Range("B" & ligne).Value = Range("B3").Value And Range("C" & ligne).Value = Range("D3").Value) Then
        ClExiste = True
        Exit Do
    End If

    ligne = ligne + 1
    If (ligne > 10000) Then Exit Do
Loop

End Function

Merci de ton aide

pierrejean · 8 Avril 2021

Re
Le même problème existe pour la fonction Clexiste
changer 1 en 2 dans Do While Cells(ligne, 1).Value <> ""

Function ClExiste() As Boolean
Dim ligne As Integer

ligne = 22: ClExiste = False

Do While Cells(ligne, 2).Value <> ""

If (Range("B" & ligne).Value = Range("B3").Value And Range("C" & ligne).Value = Range("D3").Value) Then
ClExiste = True
Exit Do
End If

ligne = ligne + 1
If (ligne > 1000) Then Exit Do
Loop

End Function

Muzzik · 8 Avril 2021

C'est ce que j'ai fait a l'issue de votre premier message pour tester.
J'avais mis la copie des fonction modifiées dans mon dernier message.
Mais le résultat reste le meme l'insertion d'un nouveau contact me supprime un existant de la base.
d'ou ma question
"Je ne sais pas si cela peut répondre a cela mais après avoir réalisé les différents test j'ai par le biais d'un copier/coller insérer dans la BDD a partir de la ligne 22 environ 500 contacts. cela aurait il pu avoir une incidence, créer un décalage dans le bon fonctionnement de la macro.
Quoi qu'il en soit cette base n'est pas destiné a héberger plus de 600/700 max contacts"

VB:

Function NvLigne()
Dim ligne As Integer

ligne = 22

Do While Cells(ligne, [B]2[/B]).Value <> ""

    ligne = ligne + 1
    If (ligne > 10000) Then Exit Do

Loop

NvLigne = ligne

End Function

Function ClExiste() As Boolean
Dim ligne As Integer

ligne = 22: ClExiste = False
Do While Cells(ligne, [B]2[/B]).Value <> ""

    If (Range("B" & ligne).Value = Range("B3").Value And Range("C" & ligne).Value = Range("D3").Value) Then

        ClExiste = True
        Exit Do
    End If

    ligne = ligne + 1
    If (ligne > 10000) Then Exit Do

Loop
End Function

Microsoft 365 Assistance pour correction Macro

Muzzik

XLDnaute Nouveau

Pièces jointes

pierrejean

XLDnaute Barbatruc

Muzzik

XLDnaute Nouveau

pierrejean

XLDnaute Barbatruc

Muzzik

XLDnaute Nouveau

Discussions similaires