Lancer Macro à l'ouverture de n'importe quel fichier Excel avec un userform

Bonjour et bonne année,

J'ai réalisé une macro me permettant de comparer plusieurs fichiers entre eux. Ces fichiers changent chaque jours et ce n'est jamais les mêmes fichiers.

1 - Sur un fichier .xlsm à l'ouverture, un userform s'ouvre avec la possibilité de sélectionner le chemin de deux fichiers à comparer.

r0mv

2 - Les deux fichiers excel s'ouvrent et sont automatiquement mis en forme (je ne sais comment mais bon il semble qu'une macro de mise en forme que j'ai crée se lance seule automatiquement sans que je sache comment, mais tant mieux j'en ai besoin ...).

3 - A l'aide d'une macro dans PERSONNAL.XLS que je dois actuellement lancer manuellement (lance_auto), je vérifie si le fichier à comparer est le bon, je récupère son chemin et je lance la procédure de comparaison.

Mon besoin est :

Je voudrais que l'étape 3 soit réalisée automatiquement, c'est-à-dire qu'à l'ouverture de n'importe quel fichier à l'étape 2 la macro "lance_auto" soit lancé automatiquement.

Ci dessous mon fichier de l'étape 1 et les macros dans PERSONNAL.XLS

Sub lance_auto() 'Je vérifie que le nom du fichier correspond, si oui je lance la macro de comparaison'
On Error GoTo Erreur
If ActiveWorkbook. Name = Workbooks("Comparatif.xlsm").Sheets("Feuil1").Range("B4").Value Then
Macro_a_lancer
End If
Erreur:
End Sub
Function chainevalide3(txt As String, matrice) As String 'fonction pour une regexp qui va récupérer le nom d'un fichier sur son chemin absolu'

    With CreateObject("VBScript.RegExp")
        .Pattern = matrice
        .IgnoreCase = True
        chainevalide3 = .Execute(txt)(0)
    End With
End Function

Sub Macro_a_lancer()

    Columns("A:A").Select 'Mise en forme'
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1)), _
        TrailingMinusNumbers:=True

         Dim texte As String
    texte = Workbooks("Comparatif.xlsm").Sheets("Feuil1").Range("B2").Value
   nomfile = chainevalide3(texte, "[ \w-]+\..*") 'Regex'

    Sheets.Add(After:=ActiveSheet).Name = "Difference"

    nomFeuille = Sheets(1).Name
Worksheets(nomFeuille).Range("A1:Z10000").Copy Destination:=Worksheets("Difference").Range("A1")

Dim Nom As String

Nom = nomfile

Range("T1").Select
    ActiveCell.FormulaR1C1 = "différent ?"
 Range("T2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-16]="""","""",IFERROR(IF(RC[-16]=VLOOKUP(RC[-16]," & Nom & "!C4,1,FALSE),"""",""différent""),""différent""))" 'Formule pour la comparaison'

     Range("T2").Select
    Selection.AutoFill Destination:=Range("T2:T100000"), Type:=xlFillDefault
    Range("T2:T100000").Select

   Columns("T:T").Select
    Selection.AutoFilter
    ActiveSheet.Range("$T$1:$T$10000").AutoFilter Field:=1, Criteria1:="<>"

    End

End Sub

En vous remerciant par avance !

19comparatif.xlsm (19.06 Ko)

Bonjour,

Bonne année également,

Pour cela, il convient d'utiliser un événement au niveau "Application", d'un classeur "toujours ouvert".

Cela tombe bien, ton classeur "personnal" est ouvert systématiquement.

1- Dans le module ThisWorkbook de ton classeur personnal, insère ce code :

Option Explicit

Private Cl As ClassAppEvents

Private Sub Workbook_Open()
   Set Cl = New ClassAppEvents
End Sub

2- Toujours dans le classeur personnal, insère un Module de classe et nomme le : ClassAppEvents

Insères-y ce code :

Option Explicit

Public WithEvents App As Application

Private Sub Class_Initialize()
   Set App = Application
End Sub
Private Sub App_WorkbookOpen(ByVal Wb As Workbook) 
    'deux choix :
    'appeler "lance_auto :
    'Call lance_auto 
    'ou intégrer ta macro "lance_auto" ici :
    'On Error GoTo Erreur
    'If Wb. Name = Workbooks("Comparatif.xlsm").Sheets("Feuil1").Range("B4").Value Then
    '    Macro_a_lancer
    'End If
'Erreur:    
End Sub

Teste ça et dis nous...

Merci beaucoup ! Ca fonctionne parfaitement !

Bonne journée

Rechercher des sujets similaires à "lancer macro ouverture importe quel fichier userform"