IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Assistance et correction sur Macro


Sujet :

Macros et VBA Excel

  1. #1
    Nouveau membre du Club
    Homme Profil pro
    Gérant de pme
    Inscrit en
    juin 2012
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Gérant de pme
    Secteur : Distribution

    Informations forums :
    Inscription : juin 2012
    Messages : 79
    Points : 28
    Points
    28
    Par défaut Assistance et correction sur Macro
    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

    Petite question tout me semblait bien fonctionner et j'ai du coup par le biais d'un copier coller ajouter dans la base 500 contacts.

    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
    Test pour consulation 2021 V2 sans données.xlsm
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
     
    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
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
     
    Dim lignesel As Integer
     
    Private Sub Ajouter_Click()
        insertion ("Ajout")
    End Sub
     
    Private Sub Deverouiller_Click()
        ActiveSheet.Unprotect
    End Sub
     
    Private Sub Modifier_Click()
        insertion ("Modif")
    End Sub
     
    Private Sub insertion(mode As String)
    Dim ligne As Integer: Dim test As Boolean
     
    test = False
    If (Range("P8").Value >= 0) Then 'vérifie si tous les champs sont bien a o et non pas Nok, cette vérification 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 N° secu affichage B=>B3'
        Range("C" & ligne).Value = Range("D3").Value 'fonction qui permet de récupérer Nom affichage C=>D3'
        Range("D" & ligne).Value = Range("G3").Value 'fonction qui permet de récupérer Prénom affichage D=>G3'
        Range("E" & ligne).Value = Range("D6").Value 'fonction qui permet de récupérer Date de naissance affichage E=>D6'
        Range("F" & ligne).Value = Range("N11").Value 'fonction qui permet de récupérer Age affichage F=>B6'
        Range("G" & ligne).Value = Range("G6").Value 'fonction qui permet de récupérer Téléphone affichage G=>G6'
        Range("H" & ligne).Value = Range("B12").Value 'fonction qui permet de récupérer Statut affichage H=>B12'
        Range("I" & ligne).Value = Range("D12").Value 'fonction qui permet de récupérer Grade affichage I=>D12'
        Range("J" & ligne).Value = Range("G12").Value 'fonction qui permet de récupérer Service affichage I=>D12'
        Range("K" & ligne).Value = Range("B9").Value 'fonction qui permet de récupérer Date de dernière visite affichage J=>B9'
        Range("L" & ligne).Value = Range("N12").Value 'fonction qui permet de récupérer Prochain RDV a 18mois affichage K=>D9'
        Range("M" & ligne).Value = Range("G9").Value 'fonction qui permet de récupérer Fin de contrat affichage L=>G9'
        Range("N" & ligne).Value = Range("B15").Value 'fonction qui permet de récupérer Commentaires affichage M=>B15'
        Range("O" & ligne).Value = Range("J3").Value 'fonction qui permet de récupérer Vaccin N°1 affichage N=>J3'
        Range("P" & ligne).Value = Range("K3").Value 'fonction qui permet de récupérer Date Rappel vaccin N°1 affichage O=>K3'
        Range("Q" & ligne).Value = Range("J4").Value 'fonction qui permet de récupérer Vaccin N°2 affichage P=>J4'
        Range("R" & ligne).Value = Range("K4").Value 'fonction qui permet de récupérer Date Rappel vaccin N°2 affichage Q=>K4'
        Range("S" & ligne).Value = Range("J5").Value 'fonction qui permet de récupérer Vaccin N°3 affichage R=>J5'
        Range("T" & ligne).Value = Range("K5").Value 'fonction qui permet de récupérer Date Rappel vaccin N°3 affichage S=>K5'
        Range("U" & ligne).Value = Range("J6").Value 'fonction qui permet de récupérer Vaccin N°4 affichage T=>J6'
        Range("V" & ligne).Value = Range("K6").Value 'fonction qui permet de récupérer Date Rappel vaccin N°4 affichage U=>K6'
        Range("W" & ligne).Value = Range("J7").Value 'fonction qui permet de récupérer Vaccin N°5 affichage V=>J7'
        Range("X" & ligne).Value = Range("K7").Value 'fonction qui permet de récupérer Date Rappel vaccin N°5 affichage W=>K7'
     
    Else
        MsgBox "Numéro de Securité Social déja 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 "Merci de remplir un minimum de 3 champs" 'message a modifier en fonction des attentes'
     
    End If
     
    End Sub
     
    Private Sub vider_form()
     
        Range("B3").Value = "" 'fonction qui permet de vider les informations dans le formulaire affichage=>B3'
        Range("D3").Value = ""
        Range("G3").Value = ""
        Range("D6").Value = ""
        Range("B6").Value = ""
        Range("G6").Value = ""
        Range("B12").Value = ""
        Range("D12").Value = ""
        Range("G12").Value = ""
        Range("B9").Value = ""
        Range("D9").Value = ""
        Range("G9").Value = ""
        Range("B15").Value = ""
        Range("J3").Value = ""
        Range("K3").Value = ""
        Range("J4").Value = ""
        Range("K4").Value = ""
        Range("J5").Value = ""
        Range("K5").Value = ""
        Range("J6").Value = ""
        Range("K6").Value = ""
        Range("J7").Value = ""
        Range("K7").Value = ""
     
    End Sub
     
    Private Sub Supprimer_Click()
    Dim ligne As Integer
    ligne = lignesel
     
    If (ligne > 0) Then
     
        ActiveSheet.Unprotect 'supprime la protection de le feuille active'
     
        Do While Range("B" & ligne).Value <> ""
        Range("B" & ligne & ":X" & ligne).Value = Range("B" & ligne + 1 & ":X" & ligne + 1).Value
        ligne = ligne + 1
        If (ligne > 10000) Then Exit Do
     
        Loop
     
        lignesel = 0
     
     
        vider_form 'appel de la fonction vider le formulaire'
     
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'active la protection de le feuille active'
     
    End If
     
    End Sub
     
    Private Sub Vider_Click()
    vider_form
    End Sub
     
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim ligne As Integer: Dim colonne As Integer
    ligne = Target.Row: colonne = Target.Column
        If (ligne >= 22 And colonne >= 2 And colonne <= 23) Then ' permet de selectionner la première ligne de la base dans l'exemple (Ligne 22) et sur le total de colonne (23) dans l'exemple B22=>X22'
     
        lignesel = ligne
     
        Range("B" & ligne & ":X" & ligne).Select ' pour mettre en surbrillance la ligne selectionner'
     
        Range("B3").Value = Range("B" & ligne).Value 'fonction qui permet de restituer la valeur de la ligne selectionné dans son champ respectif'
        Range("D3").Value = Range("C" & ligne).Value
        Range("G3").Value = Range("D" & ligne).Value
        Range("D6").Value = Range("E" & ligne).Value
        Range("B6").Value = Range("F" & ligne).Value
        Range("G6").Value = Range("G" & ligne).Value
        Range("B12").Value = Range("H" & ligne).Value
        Range("D12").Value = Range("I" & ligne).Value
        Range("G12").Value = Range("J" & ligne).Value
        Range("B9").Value = Range("K" & ligne).Value
        Range("D9").Value = Range("L" & ligne).Value
        Range("G9").Value = Range("M" & ligne).Value
        Range("B15").Value = Range("N" & ligne).Value
        Range("J3").Value = Range("O" & ligne).Value
        Range("K3").Value = Range("P" & ligne).Value
        Range("J4").Value = Range("Q" & ligne).Value
        Range("K4").Value = Range("R" & ligne).Value
        Range("J5").Value = Range("S" & ligne).Value
        Range("K5").Value = Range("T" & ligne).Value
        Range("J6").Value = Range("U" & ligne).Value
        Range("K6").Value = Range("V" & ligne).Value
        Range("J7").Value = Range("W" & ligne).Value
        Range("K7").Value = Range("X" & ligne).Value
     
     
    End If
     
    End Sub

  2. #2
    Responsable
    Office & Excel


    Homme Profil pro
    Formateur et développeur chez EXCELLEZ.net
    Inscrit en
    novembre 2003
    Messages
    17 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur chez EXCELLEZ.net
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2003
    Messages : 17 453
    Points : 50 457
    Points
    50 457
    Billets dans le blog
    92
    Par défaut
    Salut.

    Je donne une explication à une demande similaire dans cette discussion. L'utilisation des références structurées t'aidera à créer un code lisible et maintenable.


    Voici comment j'écrirais le code de la procédure qui transfère les données dans la table. Au passage, avec un tableau structuré, il n'est pas nécessaire de prévoir des lignes vides. C'est même contre-productif. J'ai donc supprimé les lignes en trop de ton tableau. Ca permet au code de trouver facilement la nouvelle ligne puisqu'on peut l'ajouter et en récupérer la position.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    Private Sub insertion(mode As String)
      Dim ligne As Long
      Dim test As Boolean
     
      test = False
      If (Range("P8").Value = 3) 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'
        ActiveSheet.Unprotect 'supprime la protection de le feuille active'
        If (mode = "Ajout") Then
        ligne = Range("tableau2").ListObject.ListRows.Add.Index
        If (ClExiste = True) Then test = True
      Else
          ligne = lignesel - Range("tableau2").Row + 1
      End If
     
     
     
      If test = False Then
        Range("tableau2[N° Sécurité Social]")(ligne).Value = Range("f_NumSoc").Value 'fonction qui permet de récupérer N° secu affichage B=>B3'
        Range("tableau2[Nom]")(ligne).Value = Range("f_Nom").Value 'fonction qui permet de récupérer Nom affichage C=>D3'
        ...
        ...

    On pourrait améliorer d'autres choses dans le code, mais si déjà tu utilises le code proposé ci-dessus, ça résoudra ton problème de mauvaise ligne.
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Pensez à utiliser les tableaux structurés. Ils vous simplifieront la vie, tant en Excel qu'en VBA ==> mon tuto
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------

  3. #3
    Nouveau membre du Club
    Homme Profil pro
    Gérant de pme
    Inscrit en
    juin 2012
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Gérant de pme
    Secteur : Distribution

    Informations forums :
    Inscription : juin 2012
    Messages : 79
    Points : 28
    Points
    28
    Par défaut
    Bonjour Pierre

    Un grand merci de te pencher sur ma problématique.
    si je comprends bien je modifie la liste en dessous de mon formulaire en structurant celui ci sous forme de tableau, par contre je n'ai pas bien compris, je dois définir un Nom a chaque entête de mon tableau structuré

    N° Sécurité Social => F_NumSoc en lui faisant référence a lui même =Tableau2[[#En-têtes];[N° Sécurité Social]]
    Nom => F_Nom
    etc

    Je debute en VBA, mais curieux d'apprendre et de bien faire.

    Merci de ton aide

  4. #4
    Responsable
    Office & Excel


    Homme Profil pro
    Formateur et développeur chez EXCELLEZ.net
    Inscrit en
    novembre 2003
    Messages
    17 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur chez EXCELLEZ.net
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2003
    Messages : 17 453
    Points : 50 457
    Points
    50 457
    Billets dans le blog
    92
    Par défaut
    En fait, tes données sont déjà dans un tableau structuré (appelé aussi table, liste ou table dynamique). Donc ça c'est ok. Mais il y a trop de lignes (580) alors qu'un avantage du tableau structuré, c'est qu'il n'est pas nécessaire de prévoir des lignes pour les ajouts. Tu peux ajouter une ligne manuellement, par TAB ou par clic droit. De plus, en l'absence de ligne de total, saisir une donnée sur la ligne qui suit la dernière du tableau étend celui-ci à cette nouvelle ligne (selon les options par défaut d'Excel). De plus, ton code VBA bénéficie de cela car le tableau structuré en VBA dispose d'une méthode qui ajoute une ligne et permet de la traiter, notamment grâce à la propriété Index comme le montre mon code (range(...).ListObject.ListRows.Add.index). il serait intéressant de le renommer. Ici, je vais le renommer t_Data.

    Les cellules F_NumSoc, f_Nom et f_Prenom utilisées dans mon code sont des cellules nommées donc la référence peut être utilisée dans le code (range("f_Nom")). Ce sont les cellules B3, D3, ... du "formulaire". Nommer ces cellules permet un appariement colonne du tableau/Cellule formulaire (range("t_Data[Nom]")(index).Value = range("f_Nom").value).

    Lorsque cela est fait, on peut alors écrire le code qui transfère dans une nouvelle ligne (ou qui met une ligne à jour). A priori, c'est la même procédure qui sera utilisée pour les deux actions, car elle va recevoir l'index de la ligne sur laquelle écrire (l'index de la nouvelle pour un ajout et l'index retrouvé par une fonction spécifique pour une mise à jour)...

    Idéalement, tes listes déroulantes (statut, service, grade) devraient s'appuyer sur des tableaux structurés elles aussi, avec une formule du type =INDIRECT("t_Grades[Grade]"). Ici, j'ai transformé la liste des grades en tableau t_Grades avec une colonne nommée Grade. J'ai fait de même pour les services et les statuts. Ca te dispense des formules nommées avec DECALER

    Pour récupérer les données du tableau et les envoyer au formulaire, c'est la même logique que pour enregistrer les données. On trouve l'index d'une ligne (et on a déjà la fonction pour cela, que j'ai mise dans le code et qui tient sur une ligne) puis on transfère: range("f_Nom").value = range("t_Data[Nom]")(index).Value. La mécanique est en fait très claire à comprendre lorsque l'on utilise les noms des colonnes et des cellules du formulaire.

    Pour le numéro de secsoc, je comprends bien l'intérêt d'une valeur de type numérique que l'on peut "formater" pour l'affichage. Dans le traitement VBA de cette donnée, vu qu'elle dépasse la capacité des entiers longs, ça pourrait poser problème. Perso, j'aurais choisi un format texte pour cette info car ce n'est en fait pas une info numérique au sens informatique du terme (on n'additionne pas des numéros de secsoc). Mais j'admets que c'est "pratique" (à la mode Excel) de formater du numérique.

    Voici le fichier sur lequel j'ai travaillé. Il n'est évidemment ni nettoyé ni achevé, mais il te montrera "sur pièces" comment mon code fonctionne et tu pourras le transférer plus aisément dans ton application.

    consultations_2021.xlsm
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Pensez à utiliser les tableaux structurés. Ils vous simplifieront la vie, tant en Excel qu'en VBA ==> mon tuto
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------

  5. #5
    Nouveau membre du Club
    Homme Profil pro
    Gérant de pme
    Inscrit en
    juin 2012
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Gérant de pme
    Secteur : Distribution

    Informations forums :
    Inscription : juin 2012
    Messages : 79
    Points : 28
    Points
    28
    Par défaut
    Bonjour Pierre,

    Merci du temps et de la patience, je vais reprendre avec les éléments transmis pour corriger/revoir la mise en forme.
    Toutes les plages nommées en gestionnaire de nom, je vais refaire cela au propre, mais je peux conserver néanmoins les fonctions "=DECALER(P_statut;0;0;NBVAL(L_statut);1)" et celles utilisée dans le formulaire, pour faciliter les saisies ou cela n'a aucun intérêt.

    Par contre petite question quand tout sera remis en forme je dois pour aider ma conjointe insérer 530 contacts déjà existant cela posera t'il un problème de copier coller ou cela n'aura pas d'incidence.

    En tout cas je pense que je vais serieusement progresser avec tes super explications, merci beaucoup, je me mets de suite au travail et reviens vers toi avec quelque chose de plus aboutis je l'éspère.

    Bien a toi

    Christophe

  6. #6
    Responsable
    Office & Excel


    Homme Profil pro
    Formateur et développeur chez EXCELLEZ.net
    Inscrit en
    novembre 2003
    Messages
    17 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur chez EXCELLEZ.net
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2003
    Messages : 17 453
    Points : 50 457
    Points
    50 457
    Billets dans le blog
    92
    Par défaut
    Pour insérer les contacts par copier-coller, ça ne pose pas de problème avec un tableau structuré car Excel va adapter sa taille. Si tes données viennent d'une feuille Excel, je préconise le copier-coller spécial valeurs pour ne pas parasiter les formats du tableau et amener dans le classeur des données attachées aux cellules de la source et qui n'auraient rien à faire dans ton nouveau classeur.

    Bon travail pour la suite. N'hésite pas à revenir nous dire bonjour au besoin
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Pensez à utiliser les tableaux structurés. Ils vous simplifieront la vie, tant en Excel qu'en VBA ==> mon tuto
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------

  7. #7
    Nouveau membre du Club
    Homme Profil pro
    Gérant de pme
    Inscrit en
    juin 2012
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Gérant de pme
    Secteur : Distribution

    Informations forums :
    Inscription : juin 2012
    Messages : 79
    Points : 28
    Points
    28
    Par défaut
    Bonsoir Pierre

    Et bien sur ceux qui liront ce message.
    J'ai remis en forme avec les explications données, mais j'ai un petit bug, pourrais tu me dire si je suis bien partis dans la bonne direction.
    j'ai une petite erreur que je n'arrive pas a corriger "Index = Range("T_data[N° Sécurité Social]").ListObject.ListRows.Add.Index" erreur d'execution 1004.

    Pour valider mon travail jNew statistiques Consult 2021.xlsme te transmet celui ci.

    Bien a toi

  8. #8
    Responsable
    Office & Excel


    Homme Profil pro
    Formateur et développeur chez EXCELLEZ.net
    Inscrit en
    novembre 2003
    Messages
    17 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur chez EXCELLEZ.net
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2003
    Messages : 17 453
    Points : 50 457
    Points
    50 457
    Billets dans le blog
    92
    Par défaut
    Salut.

    En fait, lors de mon test, j'avais déjà déprotégé la feuille, de sorte que le problème est passé crème.

    Normalement, ce sont les procédures Ajouter_Click et Modifier_Click qui devraient déverrouiller la feuille et la reverrouiller après traitement. Ca correspondrait à une meilleure architecture. Idéalement, ce sont elles aussi qui devraient tester que les données sont complètes. Là aussi, on a une architecture correcte, car la procédure Insertion ne doit avoir comme rôle que le transfert des données.

    Du coup, voici comment je coderais les procédures:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    Private Sub Ajouter_Click()
      Dim Index As Long
     
      On Error GoTo Catch
      If (Range("P8").Value = 3) Then
        If IndexLigne(Range("C_N°Sécu").Value) = 0 Then
          ActiveSheet.Unprotect
          Index = Range("T_data[N° Sécurité Social]").ListObject.ListRows.Add.Index
          insertion Index
        Else
          MsgBox "Ce numéro existe"
        End If
      Else
        MsgBox "Données incomplètes"
      End If
     
    Catch:
      ActiveSheet.Protect
      If Err <> 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Erreur durant l'enregistrement"
    End Sub
     
    Private Sub Modifier_Click()
      Dim Index As Long
     
      On Error GoTo Catch
     
      If (Range("P8").Value = 3) Then
        Index = IndexLigne(Range("C_N°Sécu").Value)
        If Index > 0 Then
          ActiveSheet.Unprotect
          insertion Index
        Else
          MsgBox "Ce numéro n'existe pas"
        End If
      Else
        MsgBox "Données incomplètes"
      End If
     
    Catch:
      ActiveSheet.Protect
      If Err <> 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Erreur durant l'enregistrement"
    End Sub
    La macro d'insertion se résume alors à une suite de transfert de cellules:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    Private Sub insertion(Index As Long)
      Range("T_data[N° Sécurité Social]")(Index).Value = Range("C_N°Sécu").Value
      Range("T_data[Nom]")(Index).Value = Range("C_Nom").Value
      Range("T_data[Prénom]")(Index).Value = Range("C_Prénom").Value
      Range("T_data[Date de Naissance]")(Index).Value = Range("C_DateNaissance").Value
      Range("T_data[Age]")(Index).Value = Range("C_Age").Value
      Range("T_data[Numéro Téléphone]")(Index).Value = Range("C_Numtel").Value
      Range("T_data[Statut]")(Index).Value = Range("C_Statut").Value
      Range("T_data[Grade]")(Index).Value = Range("C_Grade").Value
      Range("T_data[Service]")(Index).Value = Range("C_Service").Value
      Range("T_data[Date de dernière visite Médicale]")(Index).Value = Range("C_Datevisite").Value
      Range("T_data[Prochain RDV à 18 Mois]")(Index).Value = Range("C_ProchainRDV").Value
      Range("T_data[Date de fin de Contrat]")(Index).Value = Range("C_FindeContrat").Value
      Range("T_data[Commentaires]")(Index).Value = Range("C_Commentaires").Value
      Range("T_data[BCG]")(Index).Value = Range("C_BCG").Value
      Range("T_data[Tubertest]")(Index).Value = Range("C_Tubertest").Value
      Range("T_data[Coqueluche]")(Index).Value = Range("C_Coqueluche").Value
      Range("T_data[Covid]")(Index).Value = Range("C_Covid").Value
      Range("T_data[DTP]")(Index).Value = Range("C_DTP").Value
      Range("T_data[Grippe]")(Index).Value = Range("C_Grippe").Value
      Range("T_data[Hépatite]")(Index).Value = Range("C_Hépatite").Value
      Range("T_data[ROR]")(Index).Value = Range("C_ROR").Value
      Range("T_data[Varicelle]")(Index).Value = Range("C_Varicelle").Value
      vider_form  'procédure pour vider le formulaire et démarrer un nouvel enregistrement'
    End Sub
    Tant que j'y étais, j'ai un peu remodelé le Worksheet_SelectionChange et la procédure de récupération des données du tableau vers le formulaire. La procédure de transfert DataVersFormulaire ne doit avoir qu'un seul rôle, le transfert (comme la procédure d'insertion). C'est le Worksheet_SelectionChange qui va retrouver la ligne (par simple différence arithmétique, désactiver l'écoute de SelectionChange (car dans cette procédure, tu sélectionnes des cellules => nouvel appel de l'évènement). Ces procédures sont bien entendu encadrées d'une gestion d'erreur pour remettre tout en ordre en fin de traitement.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      ' Ici, on devrait appeler une fonction qui lit les données
      ' A nouveau, l'idée est de trouver la ligne du tableau comme index
      ' puis d'utiliser range("f_Nom").value = range("t_Data[Nom]")(Index).Value
      ' et ainsi de suite pour les autres lignes
     
      Dim Index As Long
     
      On Error GoTo Catch
     
      If Not Intersect(Target, Range("t_Data[N° Sécurité Social]")) Is Nothing Then ' permet de selectionner la première ligne de la base dans l'exemple (Ligne 22) et sur le total de colonne (23) dans l'exemple B22=>X22'
        Application.EnableEvents = False
        Index = Target.Row - Range("t_Data[#Headers]").Row
        Range("t_Data").ListObject.ListRows(Index).Range.Select ' pour mettre en surbrillance la ligne selectionner'
        DataVersFormulaire Index
      End If
     
    Catch:
      Application.EnableEvents = True
    End Sub
     
    Sub DataVersFormulaire(Index As Long)
      Range("C_N°Sécu").Value = Range("T_data[N° Sécurité Social]")(Index).Value
      Range("C_Nom").Value = Range("T_data[Nom]")(Index).Value
      Range("C_Prénom ").Value = Range("T_data[Prénom]")(Index).Value
      Range("C_DateNaissance").Value = Range("T_data[Date de Naissance]")(Index).Value
      Range("C_Age").Value = Range("T_data[Age]")(Index).Value
      Range("C_Numtel").Value = Range("T_data[Numéro Téléphone]")(Index).Value
      Range("C_Statut").Value = Range("T_data[Statut]")(Index).Value
      Range("C_Grade").Value = Range("T_data[Grade]")(Index).Value
      Range("C_Service").Value = Range("T_data[Service]")(Index).Value
      Range("C_Datevisite").Value = Range("T_data[Date de dernière visite Médicale]")(Index).Value
      Range("C_ProchainRDV").Value = Range("T_data[Prochain RDV à 18 Mois]")(Index).Value
      Range("C_FindeContrat").Value = Range("T_data[Date de fin de Contrat]")(Index).Value
      Range("C_Commentaires").Value = Range("T_data[Commentaires]")(Index).Value
      Range("C_BCG").Value = Range("T_data[BCG]")(Index).Value
      Range("C_Tubertest").Value = Range("T_data[Tubertest]")(Index).Value
      Range("C_Coqueluche").Value = Range("T_data[Coqueluche]")(Index).Value
      Range("C_Covid").Value = Range("T_data[Covid]")(Index).Value
      Range("C_DTP").Value = Range("T_data[DTP]")(Index).Value
      Range("C_Grippe").Value = Range("T_data[Grippe]")(Index).Value
      Range("C_Hépatite").Value = Range("T_data[Hépatite]")(Index).Value
      Range("C_ROR").Value = Range("T_data[ROR]")(Index).Value
      Range("C_Varicelle").Value = Range("T_data[Varicelle]")(Index).Value
    End Sub
    New statistiques Consult 2021_Pierre.xlsm


    Attention que dans ton fichier, la colonne Tubertest était "mal nommée" car un espace trainait à droite du mot. J'ai corrigé dans le fichier que je te remets. A toi à corriger dans ton fichier
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Pensez à utiliser les tableaux structurés. Ils vous simplifieront la vie, tant en Excel qu'en VBA ==> mon tuto
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------

  9. #9
    Nouveau membre du Club
    Homme Profil pro
    Gérant de pme
    Inscrit en
    juin 2012
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Gérant de pme
    Secteur : Distribution

    Informations forums :
    Inscription : juin 2012
    Messages : 79
    Points : 28
    Points
    28
    Par défaut
    Super merci de ton retour

    Mais j'ai encore besoin de tes lumières pour finaliser la procédure de suppression
    Je ne comprends pas et ne sais pas faire cette partie
    Quand tu parles de récupérer l'index j'avoue ne pas savoir faire mais je suis certain que tes lumières vont m'éclairer


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    Private Sub Supprimer_Click()
      ' Ici, on peut aussi récupérer l'index de la ligne à supprimer
      ' puis on peut utiliser Range("t_Data").listobject.listrows(Index).delete
     
    Dim ligne As Integer
     
    ligne = lignesel
     
    If (ligne > 0) Then
     
        ActiveSheet.Unprotect 'supprime la protection de le feuille active'
     
        Do While Range("B" & ligne).Value <> ""
        Range("B" & ligne & ":W" & ligne).Value = Range("B" & ligne + 1 & ":W" & ligne + 1).Value
        ligne = ligne + 1
        If (ligne > 10000) Then Exit Do
     
        Loop
     
        lignesel = 0
     
     
        vider_form 'appel de la fonction vider le formulaire'
     
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'active la protection de le feuille active'
     
    End If
     
    End Sub
    J'ai appliqué ton conseil pour raccourcir la procédure vider_form 'Range("F_viderform").Value = ""'
    Je te remercie pour ses conseils qui me font progresser.

  10. #10
    Responsable
    Office & Excel


    Homme Profil pro
    Formateur et développeur chez EXCELLEZ.net
    Inscrit en
    novembre 2003
    Messages
    17 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur chez EXCELLEZ.net
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2003
    Messages : 17 453
    Points : 50 457
    Points
    50 457
    Billets dans le blog
    92
    Par défaut
    Dans une application telle que celle que tu développes, l'idée est de s'appuyer systématiquement sur les tableaux structurés pour le code en VBA. Dans cette optique, la position d'une ligne par rapport au tableau (et pas par rapport à la feuille) est un élément central. C'est le rôle de la variable Index que j'utilise (ce nom est arbitraire, on aurait pu l'appeler NumeroLigne).

    On peut calculer cet index de plusieursfaçons:
    en s'appuyant sur un indice du tableau, idéalement une valeur unique comme le numéro de secsoc, ce qui est réalisé par la fonction IndexLigne du module 1 qui utilise Evaluate et EQUIV (MATCH en anglais);
    en cherchant cet index via une formule conditionnelle en VBA (en gros un EQUIV plus évolué multi-critères);
    en retrouvant cet index par la cellule active si celle-ci est située dans le tableau, comme je le montre dans le code suivant.


    Voici le code du bouton Supprimer qui travaille sur la cellule active. Idéalement, on devrait isoler la suppression proprement dite du code du bouton, mais on peut rester simple aussi.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    Private Sub Supprimer_Click()
      Dim Index As Long
      Dim Answer As VbMsgBoxResult
     
      On Error GoTo Catch
      Application.EnableEvents = False
      If Not Intersect(ActiveCell, Range("t_Data")) Is Nothing Then
        Answer = MsgBox("Voulez-vous supprimer cette ligne?", vbQuestion + vbYesNo, "Suppression d'un enregistrement")
        If Answer = vbYes Then
          ActiveSheet.Unprotect
          Index = ActiveCell.Row - Range("t_Data[#headers]").Row
          Range("t_Data").ListObject.ListRows(Index).Delete
        End If
      End If
     
    Catch:
      ActiveSheet.Protect
      Application.EnableEvents = True
      If Err <> 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Erreur durant la suppression"
    End Sub
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Pensez à utiliser les tableaux structurés. Ils vous simplifieront la vie, tant en Excel qu'en VBA ==> mon tuto
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------

  11. #11
    Nouveau membre du Club
    Homme Profil pro
    Gérant de pme
    Inscrit en
    juin 2012
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Gérant de pme
    Secteur : Distribution

    Informations forums :
    Inscription : juin 2012
    Messages : 79
    Points : 28
    Points
    28
    Par défaut
    Bonjour Pierre,

    Un IMMENSE Merci pour ta pédagogie et tes conseils, je viens de finaliser mon travail grâce a ton expertise.
    Sans tes conseils et ta méthodologie j'y serais encore.

    Maintenant que j'ai finis le travail pour ma chère et tendre épouse, elle va avoir enfin une base pour suivre correctement ses patients.
    Plus qu'a maintenant reproduire ce travail pour me faire ma BDD de prospection et suivi de mes propres clients & contacts.

    Encore Merci pour ton aide.
    Bien a toi

    Christophe

  12. #12
    Nouveau membre du Club
    Homme Profil pro
    Gérant de pme
    Inscrit en
    juin 2012
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Gérant de pme
    Secteur : Distribution

    Informations forums :
    Inscription : juin 2012
    Messages : 79
    Points : 28
    Points
    28
    Par défaut
    Bonsoir Pierre,

    J'ai ajouté les 520 contacts dans la base, mais je n'ai pas pensé que le controle est actuellement établi sur
    Index = IndexLigne(Range("C_N°Sécu").Value), sauf que justement ce travail est réalisé pour que mon épouse puisse mettre a jour et faire vivre cette base.
    A ce jour je n'ai pas l'ensemble des N°Sécu, par contre j'ai l'ensemble des Nom & Prénom, penses tu que nous puissions modifier pour effectuer un controle sur plusieurs items.
    Car apres test il s'avère que si je modifie un contact sans avoir son N°Sécu il m'en crée un nouveau donc j'ai des doublons,...

    Souhaites tu que je te transmette le fichier finalisé

    Cordialement

  13. #13
    Responsable
    Office & Excel


    Homme Profil pro
    Formateur et développeur chez EXCELLEZ.net
    Inscrit en
    novembre 2003
    Messages
    17 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur chez EXCELLEZ.net
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2003
    Messages : 17 453
    Points : 50 457
    Points
    50 457
    Billets dans le blog
    92
    Par défaut
    En fait, j'ai pensé hier que si tu amènes les données par copier-coller, il faut faire attention que l'écoute de l'évènement Selection_Change pourrait perturber ton copier-coller et qu'il conviendrait de désactiver temporairement cette écoute. Dans la fenêtre d'exécution (CTRL+G), tu pourrais saisir Application.EnableEvents = False le temps du transfert puis, toujours par cette fenêtre, le remettre à True après le transfert.


    Evidemment, le numéro de secsoc est intéressant puisque unique, mais il faut effectivement qu'il soit renseigné sans cela, tous les numéros vides sont potentiellement des doublons. Réaliser le test de doublons sur le couple Nom-Prénom est tentant, mais si ton épouse a deux Jean Dupont dans sa patientèle, ça va poser problème. La date de naissance, si elle est toujours connue, pourrait être jointe au couple Nom-Prénom pour tester le doublon.

    Une autre solution pourrait être de renseigner un numéro "interne" en absence de numéro national (une simple incrémentation en partant de 1 pourrait suffire puisqu'il n'y aurait pas de risque de collision avec un numéro secsoc. Autre idée encore, établir systématiquement un numéro de patient, indépendamment du numéro de secsoc.

    Il faudrait voir avec ton épouse ce qu'elle en pense avant de partir sur une solution technique.
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Pensez à utiliser les tableaux structurés. Ils vous simplifieront la vie, tant en Excel qu'en VBA ==> mon tuto
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------

  14. #14
    Nouveau membre du Club
    Homme Profil pro
    Gérant de pme
    Inscrit en
    juin 2012
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Gérant de pme
    Secteur : Distribution

    Informations forums :
    Inscription : juin 2012
    Messages : 79
    Points : 28
    Points
    28
    Par défaut
    effectivement le copier coller ayant déja été réalisé je n'ai pas utilisé la méthode
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Application.EnableEvents = False
    Pour régler mon proble de Numsoc, j'ai appliqué un numéro incrémenté pour tous les vides que je dois modifier au fur et a mesure.
    Le problème est que je sélectionne, modifie le Numsoc, mais je ne peux modifier car il ne reconnait pas le numéro initial, du coup je crée un nouvel enregistrement et supprime l'ancien.

    Merci en tout cas pour toutes tes explications.

    Bonne soirée a toi

Discussions similaires

  1. Réponses: 2
    Dernier message: 03/09/2014, 14h17
  2. comment créer correctement un macro sur notepad++ ?
    Par razily dans le forum EDI, CMS, Outils, Scripts et API
    Réponses: 2
    Dernier message: 09/02/2012, 11h45
  3. besoin d'une correction sur un exercice.
    Par phakso dans le forum Algorithmes et structures de données
    Réponses: 13
    Dernier message: 03/03/2006, 10h01
  4. Probleme d'enregistrement sur Macro/VBA de Excel
    Par life is magic dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 28/11/2005, 17h23
  5. ordre correct sur group ?
    Par Force59 dans le forum Langage SQL
    Réponses: 9
    Dernier message: 02/04/2004, 09h27

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo