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.
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 !
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