Paramètres macro dans un formulaire

Pir27 -
Pir27 - 25 oct. 2013 à 10:46

Bonjour,

J'utilise une macro qui utilise deux fichiers excel différents.
Chaque jour, j'utilise deux nouveaux fichiers.
J'aimerais créer un formulaire qui permet de choisir ces deux fichiers et de lancer la macro à partir de ceux-ci au lieu de modifier le code chaque jour.

d'avance merci.

Afficher la suite

A voir également:

Paramètres macro dans un formulaire
Whatsapp formulaire opposition - Guide
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Formulaire de réclamation facebook - Guide
Parametres de mon ordinateur - Guide
Paramètres dns - Guide

6 réponses

Réponse 1 / 6

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

exemple de trame pour recherche et ouverture fichier

Sub Choix_Fichier()

    'si repertoire connu
    'Chdir="C:\mon_repertoire"

    Fichier_Ouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls), *.xls")

    If Fichier_Ouvrir <> False Then
        nom_Fichier = Right(Fichier_Ouvrir, InStrRev(Fichier_Ouvrir, "\"))
        Workbooks.Open (filetoopen)
    Else
    '
    End If
End Sub

Réponse 2 / 6

Pir27

Bonjour,

J'exécute votre code et j'ai bien la fenêtre "Ouvrir' mais dès que je double clique sur le fichier j'obtiens une erreur: Erreur d'exécution '1004' : "introuvable. Vérifier l'orthographe du nom du classeur et la validité de l'emplacement.

Le bug se produit à la ligne : Workbooks.Open (filetoopen)

sinon, c'est à peu près ce que je veux mais il faudrait que le fichier sélectionné prenne la place du fichier à spécifier dans le code de ma macro (la macro que vous m'avez donné début octobre (Modification d'un tableau à partir de 2 fichiers Excel 2010).

D'avance merci.

Réponse 3 / 6

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

Un copier/merder, il faut remplacer filetoopen par Fichier_Ouvrir

vous pouvez me rappelez ce que je vous ai passe sur ce sujet

A+

Réponse 4 / 6

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

Ai trouve,

Sub traitement_enregistrements()
    Dim derlig1 As Integer, derlig2 As Integer
    Dim Dico1, Dico2, cel, Plage_ID2, Plage_ID1
    Dim CeClasseur, Fichier_Ouvrir, nom_Fichier As String
    
    Application.ScreenUpdating = False
    
    CeClasseur = ThisWorkbook.Name
    
    'si repertoire connu
    'Chdir="C:\mon_repertoire"
    'boite a dialogue
    Fichier_Ouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls), *.xls")
    'test si fichier choisi
    If Fichier_Ouvrir <> False Then
        nom_Fichier = Right(Fichier_Ouvrir, Len(Fichier_Ouvrir) - InStrRev(Fichier_Ouvrir, "\"))
    Else
        MsgBox ("PAS DE FICHIER SELECTIONNE!!!!!")
        Exit Sub
    End If
    
    Set Dico1 = CreateObject("Scripting.Dictionary")
    Set Dico2 = CreateObject("Scripting.Dictionary")
    
    'dico2 pour comparaison enregistrement(s) en trop(s) fichier1
    With Worksheets("feuil1")
        derlig2 = .Range("A" & Rows.Count).End(xlUp).Row
        Set Plage_ID2 = .Range("A2:A" & derlig2)
        For Each cel In Plage_ID2
            Dico2.Add cel.Value, cel.Value
        Next cel
    End With
    
    'ouverture fichier1.xls
    Set fichier1 = Workbooks.Open(Fichier_Ouvrir)
    
    With Workbooks(nom_Fichier).Worksheets("feuil1")
        lig = 2
        Do While .Cells(lig, 1) <> ""
            If Not Dico2.exists(Cells(lig, 1).Value) Then
                'suppression ligne
                .Rows(lig).Delete
            Else
                lig = lig + 1
            End If
        Loop
        'Dico pour ajout enregistrement manquant fichier1 dans fichier2
        derlig1 = .Range("A" & Rows.Count).End(xlUp).Row
        Set Plage_ID1 = .Range("A2:A" & derlig1)
        For Each cel In Plage_ID1
            If Not Dico1.exists(Cells(lig, 1).Value) Then
                Dico1.Add cel.Value, cel.Value
            End If
        Next cel
        'boucle pour ajout manquant
        For Each cel In Plage_ID2
            If Not Dico1.exists(cel.Value) Then
                derlig1 = derlig1 + 1
                addr = cel.Row
                .Range("A" & derlig1) = Workbooks("fichier2.xls").Worksheets("feuil1").Range("A" & addr)
                .Range("B" & derlig1) = Workbooks("fichier2.xls").Worksheets("feuil1").Range("B" & addr)
                .Range("D" & derlig1) = Workbooks("fichier2.xls").Worksheets("feuil1").Range("C" & addr)
            End If
        Next cel
    End With
    
    Set Dico1 = Nothing
    Set Dico2 = Nothing
    
    Application.ScreenUpdating = True
End Sub

A+

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 6

Pir27

Bonjour,

Merci infiniment.

J'ai compris la philosophie.
Je veux faire la même chose pour l'autre fichier.
Je peux le faire moi-même à part l'instruction CeClasseur = ThisWorkbook.Name,
je ne sais pas à quoi elle sert ni comment l'adapter pour le fichier 2.

Merci encore.

Réponse 6 / 6

Pir27

Re,

C'est peut-être beaucoup plus simple sachant que ce deuxième fichier est celui à partir duquel j'exécute la macro.
On peut peut-être le retrouver plus simplement ?

Discussions similaires

Civilité (Mr,Mme,Melle) n' apparait pas lors de l'exécution du formulaire

Contact LEBONCOIN

Votre réponse

Discussions similaires