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 :

Code VBA pour modifier sur plusieurs fichiers [XL-2016]


Sujet :

Macros et VBA Excel

Mode arborescent

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre habitué
    Homme Profil pro
    Inscrit en
    Septembre 2013
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme

    Informations forums :
    Inscription : Septembre 2013
    Messages : 8
    Par défaut Code VBA pour modifier sur plusieurs fichiers
    Bonjour chers ainés et maitres en programmation vba.
    Cela fait un certain temps que je bidouille en vba et j'avoue que c'est trop cool
    cependant je suis très emmerdé sur un cas qui semble être simple mais hélas je suis bloqué. je m'en remette a vous.
    en effet je suis bien avancé dans mon projet mais la dernière étape est de faire une modification a partir d'un seul formulaire qui va agir sur deux feuilles différentes.
    concrètement dans le fichier joint, a partir du formulaire 3 modifier les champs qui porterons sur les feuilles BDD et GESTION POSITION.
    voici le code que j'ai fais et qui me donne pas le resultat souhaité:

    Code :
    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
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    Dim Ligne, f, l
     
    Private Sub C_Categorie_Change()
     
    End Sub
     
    Private Sub CommandButton1_Click()
      Modification1
                    Dim Reponse As Long
                    Reponse = MsgBox("Modification terminée " _
                                & Chr(10) & Chr(13) & Chr(10) & Chr(13) _
                                & "Vous devez garder une historique", _
                                vbOKOnly, _
                                "Fin du Traitement")
                    If Reponse = vbOK Then
                        HISTORIQUE1 'Historisation de l'enregistrment (1°Enregistrement)
                    End If
               ' Modification
        Netoie 'Efface le formulaire de modifcation
     
    End Sub
     
    Private Sub UserForm_Initialize()
                Set f = Sheets("BDD")
                Set l = Sheets("GESTION POSITION")
                Me.C_Compagnie.List = Array("groupe1", "groupe2", "groupe3")
                Me.C_Genre.List = Array("F", "M")
                Me.C_Grade.List = Array("Grade1", "Grade2", "Grade3", "Grade4", "Grade5")
                Me.C_NbreEnfant.List = Array("01", "02", "03", "04", "05", "06", "+06")
                Me.C_Categorie.List = Array("CADRE SUP", "CADRE SUB", "CADRE MOYEN", "OUVRIER")
     
                For Each c In Range(f.[C6], f.[C65000].End(xlUp))
                    Me.C_MleRecherv.AddItem c
                Next c
                    Me.C_MleRecherv.ListIndex = 0
     
                For Each c In Range(f.[D6], f.[D65000].End(xlUp))
                    Me.C_MecRecherv.AddItem c
                Next c
                Me.C_MecRecherv.ListIndex = 0
     
                For Each c In Range(l.[C6], l.[C65000].End(xlUp))
                    Me.C_MleRecherv.AddItem c
                Next c
                Me.C_MleRecherv.ListIndex = 0
     
                For Each c In Range(l.[D6], l.[D65000].End(xlUp))
                    Me.C_MecRecherv.AddItem c
                Next c
                Me.C_MecRecherv.ListIndex = 0
    End Sub
    Private Sub C_MecRecherv_Change() 'Recherche par mecano
                RechercheparMecano1
               ' RechercheparMecano2
    End Sub
    Private Sub C_MecRecherv_Click()
               ' RechercheparMecano2
    End Sub
    Private Sub C_MleRecherv_Change()
                RechercheparMatricule1
                'RechercheparMatricule2
    End Sub
    Private Sub C_MleRecherv_Click() 'Recherche par Matricule
              '  RechercheparMatricule2
    End Sub
    Private Sub B_Validation_Click() 'Valider la modification dans BDD
                Modification
                    Dim Reponse As Long
                    Reponse = MsgBox("Modification terminée " _
                                & Chr(10) & Chr(13) & Chr(10) & Chr(13) _
                                & "Vous devez garder une historique", _
                                vbOKOnly, _
                                "Fin du Traitement")
                    If Reponse = vbOK Then
                        HISTORIQUE1 'Historisation de l'enregistrment (1°Enregistrement)
                    End If
                Modification1
               ' Netoie 'Efface le formulaire de modifcation
    End Sub
    Private Sub b_fin_Click()
                Unload Me
    End Sub
     
    Sub HISTORIQUE1() 'Action d'historisation de l'enregistrement
                        Sheets("HISTO").Select
                        Ligne = Sheets("HISTO").[D65000].End(xlUp).Row + 1
                            Sheets("HISTO").Cells(Ligne, 1) = Me.C_Grade
                            Sheets("HISTO").Cells(Ligne, 2) = Me.T_NomPrenom
                            Sheets("HISTO").Cells(Ligne, 3) = Me.T_Matricule
                            Sheets("HISTO").Cells(Ligne, 4) = Me.T_Mecano
                            Sheets("HISTO").Cells(Ligne, 5) = "Corrigeé le " & Date
                            Sheets("HISTO").Cells(Ligne, 6) = Me.T_DateArr
                            Sheets("HISTO").Cells(Ligne, 10) = Me.T_RefArr
                            Sheets("HISTO").Cells(Ligne, 11) = Now
                            Sheets("HISTO").Cells(Ligne, 12) = "Modification simple"
    End Sub
    Sub RechercheparMecano1()
                Ligne = Sheets("BDD").[D:D].Find(C_MecRecherv, LookIn:=xlValues).Row
            ' ou ligne = Me.C_MecRecherv.ListIndex + 2
                        Me.C_Grade = Cells(Ligne, 1)
                        Me.T_NomPrenom = f.Cells(Ligne, 2)
                        Me.T_Matricule = f.Cells(Ligne, 3)
                        Me.T_Mecano = f.Cells(Ligne, 4)
                        Me.T_DateNaiss = f.Cells(Ligne, 6)
                        Me.T_LieuNaiss = f.Cells(Ligne, 7)
                        Me.T_NomPere = f.Cells(Ligne, 8)
                        Me.T_NomMere = f.Cells(Ligne, 9)
                        Me.C_Compagnie = f.Cells(Ligne, 10)
                        Me.T_Service = f.Cells(Ligne, 11)
                        Me.T_EmploiTenu = f.Cells(Ligne, 12)
                        Me.C_Categorie = f.Cells(Ligne, 13)
                        Me.C_Genre = f.Cells(Ligne, 14)
                        Me.T_DebSce = f.Cells(Ligne, 16)
                        Me.T_Nomination = f.Cells(Ligne, 17)
                        Me.T_DateArr = f.Cells(Ligne, 18)
                        Me.T_RefArr = f.Cells(Ligne, 20)
                        Me.T_Conjoint = f.Cells(Ligne, 23)
                        Me.C_NbreEnfant = f.Cells(Ligne, 24)
                        Me.T_Urgence = f.Cells(Ligne, 25)
                        Me.T_Telephone = f.Cells(Ligne, 26)
       '-- civilité
                For Each c In Me.Op_SitMatrimoniale.Controls
                        If f.Cells(Ligne, "o") = c.Caption Then c.Value = True
                Next c
    End Sub
    Sub RechercheparMatricule1()
                Ligne = Sheets("BDD").[C:C].Find(C_MleRecherv, LookIn:=xlValues).Row
       'ou  ligne = Me.C_MleRecherv.ListIndex + 2
                        Me.C_Grade = f.Cells(Ligne, 1)
                        Me.T_NomPrenom = f.Cells(Ligne, 2)
                        Me.T_Matricule = f.Cells(Ligne, 3)
                        Me.T_Mecano = f.Cells(Ligne, 4)
                        Me.T_DateNaiss = f.Cells(Ligne, 6)
                        Me.T_LieuNaiss = f.Cells(Ligne, 7)
                        Me.T_NomPere = f.Cells(Ligne, 8)
                        Me.T_NomMere = f.Cells(Ligne, 9)
                        Me.C_Compagnie = f.Cells(Ligne, 10)
                        Me.T_Service = f.Cells(Ligne, 11)
                        Me.T_EmploiTenu = f.Cells(Ligne, 12)
                        Me.C_Categorie = f.Cells(Ligne, 13)
                        Me.C_Genre = f.Cells(Ligne, 14)
                        Me.T_DebSce = f.Cells(Ligne, 16)
                        Me.T_Nomination = f.Cells(Ligne, 17)
                        Me.T_DateArr = f.Cells(Ligne, 18)
                        Me.T_RefArr = f.Cells(Ligne, 20)
                        Me.T_Conjoint = f.Cells(Ligne, 23)
                        Me.C_NbreEnfant = f.Cells(Ligne, 24)
                        Me.T_Urgence = f.Cells(Ligne, 25)
                        Me.T_Telephone = f.Cells(Ligne, 26)
       '-- civilité
                For Each c In Me.Op_SitMatrimoniale.Controls
                        If f.Cells(Ligne, "o") = c.Caption Then c.Value = True
                Next c
    End Sub
    Sub RechercheparMatricule2()
              ' If Me.C_MleRecherv.ListIndex <> 0 Then
               Ligne = Sheets("GESTION POSITION").[C:C].Find(C_MleRecherv, LookIn:=xlValues).Row
       'ou  ligne = Me.C_MleRecherv.ListIndex + 2
                       Me.C_Grade = l.Cells(Ligne, 1)
                       Me.T_NomPrenom = l.Cells(Ligne, 2)
                       Me.T_Matricule = l.Cells(Ligne, 3)
                       Me.T_Mecano = l.Cells(Ligne, 4)
                       Me.T_DateNaiss = l.Cells(Ligne, 11)
                       Me.T_DebSce = l.Cells(Ligne, 13)
                       Me.T_Nomination = l.Cells(Ligne, 14)
                       Me.T_DateArr = l.Cells(Ligne, 17)
                       Me.T_RefArr = l.Cells(Ligne, 19)
                       Me.C_Compagnie = l.Cells(Ligne, 20)
                       Me.T_Service = l.Cells(Ligne, 21)
                       Me.T_EmploiTenu = l.Cells(Ligne, 22)
                       Me.C_Categorie = l.Cells(Ligne, 23)
              '  End If
    End Sub
    Sub RechercheparMecano2()
             '  If Me.C_MecRecherv.ListIndex <> 0 Then
                Ligne = Sheets("GESTION POSITION").[D:D].Find(C_MecRecherv, LookIn:=xlValues).Row
       'ou  ligne = Me.C_MleRecherv.ListIndex + 2
                        Me.C_Grade = l.Cells(Ligne, 1)
                        Me.T_NomPrenom = l.Cells(Ligne, 2)
                        Me.T_Matricule = l.Cells(Ligne, 3)
                        Me.T_Mecano = l.Cells(Ligne, 4)
                        Me.T_DateNaiss = l.Cells(Ligne, 11)
                        Me.T_DebSce = l.Cells(Ligne, 12)
                        Me.T_Nomination = l.Cells(Ligne, 14)
                        Me.T_DateArr = l.Cells(Ligne, 17)
                        Me.T_RefArr = l.Cells(Ligne, 19)
                        Me.C_Compagnie = l.Cells(Ligne, 20)
                        Me.T_Service = l.Cells(Ligne, 21)
                        Me.T_EmploiTenu = l.Cells(Ligne, 22)
                        Me.C_Categorie = l.Cells(Ligne, 23)
               ' End If
    End Sub
    Sub Modification1()  'Transfert de la modification
        '--- Transfert Formulaire dans GESTION POSITION
        Dim a As Long
        a = RechercheparMatricule2
        If a = RechercheparMatricule1 Then
                        l.Cells(Ligne, 1) = Me.C_Grade
                        l.Cells(Ligne, 2) = Me.T_NomPrenom
                        l.Cells(Ligne, 3) = Me.T_Matricule
                        l.Cells(Ligne, 4) = Me.T_Mecano
                        l.Cells(Ligne, 6) = Me.T_DateNaiss
                        l.Cells(Ligne, 13) = Me.T_DebSce
                        l.Cells(Ligne, 14) = Me.T_Nomination
                        l.Cells(Ligne, 17) = Me.T_DateArr
                        l.Cells(Ligne, 19) = Me.T_RefArr
                        l.Cells(Ligne, 20) = Me.C_Compagnie
                        l.Cells(Ligne, 21) = Me.T_Service
                        l.Cells(Ligne, 22) = Me.T_EmploiTenu
                        l.Cells(Ligne, 23) = Me.C_Categorie
        End If
    End Sub
    Sub Modification()  'Transfert de la modification
        '--- Transfert Formulaire dans BDD
                f.Cells(Ligne, 1) = Me.C_Grade
                f.Cells(Ligne, 2) = Me.T_NomPrenom
                f.Cells(Ligne, 3) = Me.T_Matricule
                f.Cells(Ligne, 4) = Me.T_Mecano
                f.Cells(Ligne, 6) = Me.T_DateNaiss
                f.Cells(Ligne, 7) = Me.T_LieuNaiss
                f.Cells(Ligne, 8) = Me.T_NomPere
                f.Cells(Ligne, 9) = Me.T_NomMere
                f.Cells(Ligne, 10) = Me.C_Compagnie
                f.Cells(Ligne, 11) = Me.T_Service
                f.Cells(Ligne, 12) = Me.T_EmploiTenu
                f.Cells(Ligne, 13) = Me.C_Categorie
                f.Cells(Ligne, 14) = Me.C_Genre
                f.Cells(Ligne, 16) = Me.T_DebSce
                f.Cells(Ligne, 17) = Me.T_Nomination
                f.Cells(Ligne, 18) = Me.T_DateArr
                f.Cells(Ligne, 20) = Me.T_RefArr
                f.Cells(Ligne, 23) = Me.T_Conjoint
                f.Cells(Ligne, 24) = Me.C_NbreEnfant
                f.Cells(Ligne, 25) = Me.T_Urgence
                f.Cells(Ligne, 26) = Me.T_Telephone
       '-- Civilité
                For Each c In Me.Op_SitMatrimoniale.Controls
                    temp = ""
                    If c.Value = True Then
                    temp = c.Caption
                    End If
                Next c
                f.Cells(Ligne, "o") = temp
    End Sub
     
    Sub Netoie()
                Me.T_NomPrenom = ""
                Me.T_DateNaiss = ""
                Me.C_Compagnie = ""
                Me.C_Genre = ""
                Me.C_Grade = ""
                Me.T_Matricule = ""
                Me.T_Mecano = ""
                Me.T_LieuNaiss = ""
                Me.T_NomPere = ""
                Me.T_NomMere = ""
                Me.T_Service = ""
                Me.T_EmploiTenu = ""
                Me.T_DebSce = ""
                Me.T_Nomination = ""
                Me.T_DateArr = ""
                Me.T_RefArr = ""
                Me.C_NbreEnfant = ""
                Me.T_Conjoint = ""
                Me.T_Urgence = ""
                Me.T_Telephone = ""
                Me.C_Categorie = ""
    End Sub
    Fichiers attachés Fichiers attachés

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 1
    Dernier message: 04/07/2018, 14h36
  2. [XL-2010] Code VBA pour trier sur combobox
    Par duplaly dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 14/04/2011, 17h56
  3. [XL-2007] code vba pour cliquer sur un bouton dans internet explorer
    Par skipeemed dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 27/01/2011, 20h21
  4. idee pour traitement sur plusieurs fichier excel
    Par jumpman dans le forum VB.NET
    Réponses: 0
    Dernier message: 28/10/2009, 19h38

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