none
Utilitaire de mise à jour de classeurs RRS feed

  • Discussion générale

  • Bonjour,

    J'utilise excel 2010

    Mon but est de créer un utilitaire qui va mettre à jour une liste d'employés à partirdu classeur "copie du classeur source.xlsm" vers le classeur "source.xlsm"

    Les deux classeurs ont un mot de passe soit 1234.

    Avec l'enregistreur de macros, j'ai réussi à faire ce que je voulais.

    Le problème, c'est d'adapter l'utilitaire en fonction de l'endroit où il sera

    enregistré.  J'ai donc besoin d'un code pour récupérer le répertoire des fichiers.

    En gros le répertoire du classeur "Copie de source.xlsm" et le classeur

    "Utilitaire" (celui où se trouve ce code) est le même.

    Le classeur "source.xlsm" est placé dans le répertoire désigné par

    la cellule "A1" de la "Feuil2" du classeur "Utilitaire".

    Ma question: comment ouvrir les classeurs "Copie de source" et "source" en fonction de leur emplacement, sachant

    que le mot de passe est 1234. Voici la macro:

    Sub Macro3()
    Dim wkb1 As String, wkb2 As String, chds As String, chdc As String
    wkb1 = "Source.xlsm"
    wkb2 = "Copie de Source.xlsm"              
    chds = Sheets("feuil2").Range("a1")                     'répertoire du classeur source.xlsm
    chdc = ThisWorkbook.Path                                      répertoirere du classeur copie de source.xlsm
        Workbooks.Open Filename:= _
           chds & wkb1 ''ouvrir source.xlsm située dans le répertoire chds MOT DE PASSE 1234
        Sheets("employes").Select  'feuilles où se trouve la liste d'employés
        Range("TabEmpDIP").ClearContents  'plage de la liste d'employés
        Workbooks.Open Filename:= _
           chdc & wkb2  'ouvrir copie de source située dans le répertoire chdc MOT DE PASSE 1234
        Sheets("employes").Select
        Range("TabEmpDIP").Copy
        Windows(wkb1).Activate
        Range("A3").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveWorkbook.Save
        ActiveWindow.Close
       Windows(wkb2).Activate
        ActiveWorkbook.Save
        ActiveWindow.Close
    End Sub

    Merci

    Flac

    mardi 28 août 2018 15:39