Ajout modification d’une base de données Excel

modus57

XLDnaute Occasionnel
Bonsoir.:D

Je dois réaliser une petite base de données sur Excel pour une association, cette application doit permettre sans connaissances particulières d’ajouter des champs dans la feuille BDD et dans la feuille qui sert de formulaire de création, consultation, modification et suppression d’enregistrement.

Dans le formulaire qui sert à créer ou supprimer un enregistrement, atteindre le premier, le dernier, le suivant ou le précédent enregistrement j’ai rencontré aucuns problèmes.

Par contre je cale sur la procédure pour modifier un enregistrement. Avant la modification d’une ou plusieurs cellules dans le formulaire je passe la ou les formules (ex. : =INDEX('BD ADHÉRENTS'!I:I;EQUIV($D$1;'BD ADHÉRENTS'!$A:$A;0)) )dans une ou des variables.
Je fais une boucle sur chaque cellules du formulaire, je compare les valeurs de ces cellules avec la valeur des cellules contenues dans la ligne de l’enregistrement de la feuille BDD, puis je copie la ou les valeurs des cellules modifiées du formulaire dans la ou les cellules correspondantes dans la ligne de l’enregistrement dans la feuille BDD et pour terminer je remplace la ou les cellules modifiées dans la feuille formulaire par la ou les valeurs stockées dans la ou les variables correspondant à ou aux cellules avant modification dans le formulaire.

J’espère que je me suis bien expliqué, voici mon code, mais je ne suis pas certain que ce soit la bonne solution :

Code:
Sub ModifEnregistrement()
Dim ValCel, Cel, Val
    For Each Cel In Range("D1,A2:L11")
        If Cel > 0 And Cel.Interior.Pattern = xlNone Then
            ValCel = Cel
            MsgBox ValCel
             Sheets("BD ADHÉRENTS").Activate
            Columns(1).Find(Sheets("FORMULAIRE ADHÉRENT").Range("num_dossier")).Activate
            Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 14)).Select
            For Each Val In Selection
                If Val = ValCel Then
                    'MsgBox "la valeur recherchée (" & ValCel & ") existe"
                Else
                    'MsgBox "la valeur recherchée (" & ValCel & ") n'existe pas"
                End If
            Next Val
        End If
  Next Cel
End Sub

Je fais appel à votre aide pour la correction ou me proposer une autre procédure.

Merci d’avance.
 
Dernière édition:

modus57

XLDnaute Occasionnel
Re : Ajout modification d’une base de données Excel

Bonjour à tous.:)

Ci-joint le classeur pour mieux comprendre le problème.

Je ne trouve pas de solution pour la procédure :
Code:
Sub ModifEenregistrement

Le compteur ne fonctionne pas ça bug à la ligne 7.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
1     Range("num_dossier").Activate
2     MsgBox Target
3         If Not Application.Intersect(Target, Range("num_dossier")) Is Nothing Then
4             If Target = Range("num_dossier") Then
5                 Application.ScreenUpdating = False
6                     Sheets("BD ADHÉRENTS").Activate
7                     Columns(1).Find(Sheets("FORMULAIRE ADHÉRENT").Range(Target)).Activate
8                     Sheets("FORMULAIRE ADHÉRENT").Range("E12") = "N° enregistrement " & ActiveCell.Row - 1 & "/" & Application.CountA(Sheets("BD ADHÉRENTS").Range("A:A")) - 1
9                     Sheets("FORMULAIRE ADHÉRENT").Activate
10                Application.ScreenUpdating = True
11            End If
12        End If
End Sub

Un petit coup de pouce, ça serait sympa.

@+
 

Pièces jointes

  • Adhérent.1.xlsm
    116.1 KB · Affichages: 69
Dernière édition:

modus57

XLDnaute Occasionnel
Re : Ajout modification d’une base de données Excel

Bonjour.:)

J'ai réglé le problème du compteur maintenant ça fonctionne, voici le code évènement modifié :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim N°dossier
N°dossier = Sheets("FORMULAIRE ADHÉRENT").Range("num_dossier")
    If Not Application.Intersect(Target, Range("num_dossier")) Is Nothing Then
        If Target = Range("num_dossier") Then
            Application.ScreenUpdating = False
            Call NumEnregistrement
            Application.ScreenUpdating = True
        End If
    End If
End Sub

Et il faut ajouter le module suivant :
Code:
Sub NumEnregistrement()
Application.ScreenUpdating = False
    Sheets("BD ADHÉRENTS").Activate
    Columns(1).Find(Sheets("FORMULAIRE ADHÉRENT").Range("num_dossier")).Activate
    Sheets("FORMULAIRE ADHÉRENT").Range("I12") = "N° enregistrement " & ActiveCell.Row - 1 & "/" & Application.CountA(Sheets("BD ADHÉRENTS").Range("A:A")) - 1
    Sheets("FORMULAIRE ADHÉRENT").Activate
Application.ScreenUpdating = True
End Sub

Vous n'avez paz une petite idée pour les boucles de mise à jour de la BD ? :)
 

Statistiques des forums

Discussions
312 211
Messages
2 086 299
Membres
103 173
dernier inscrit
Cerba95