Bonjour tout le monde ! 
Alors voila, je viens de finir une macro de compilation de fichier Excel et tout marche nickel !
Enfin sur mon PC :P
Mais sur mac c'est une autre affaire !
J'ai regardé sur des forums mais je n'ai pas trouvé une solution qui convenait pour mon problème alors je tente ma chance !
Voici le code complet de ma macro :
Mais sous mac il y a le problème des "ActiveX" qui sont une composante de windows et qui par conséquent ne fonctionnent pas sous mac.
Et je n'arrive pas à contourner le problème.
L'erreur à laquelle je fais face est la suivante:
Et le message suivant s'affiche :
"Erreur 429, un composant ActiveX ne peut pas créer d'objet"
Voila j'espère que l'un de vous sait comment contourner ce problème !
Merci d'avance
Alors voila, je viens de finir une macro de compilation de fichier Excel et tout marche nickel !
Enfin sur mon PC :P
Mais sur mac c'est une autre affaire !
J'ai regardé sur des forums mais je n'ai pas trouvé une solution qui convenait pour mon problème alors je tente ma chance !
Voici le code complet de ma macro :
Bloc de code:
Option Explicit
' Michel STAELENS
Dim MonRepertoire As String, onglet As String, autofin As Boolean, lignedeb As String, lignefin As String, coldeb As String, colfin As String, destinataire, i As Integer, dimTab As Integer, depuis As Integer
Dim TabEnTete() As String
Sub select_repertoire()
Dim Repertoire As FileDialog
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
If Repertoire.SelectedItems.Count > 0 Then
Range("repertoire").Value = Repertoire.SelectedItems(1)
End If
End Sub
Sub compiler()
' mise en place des paramètres du programme
MonRepertoire = Range("repertoire").Value
Set destinataire = ActiveWorkbook
coldeb = Range("coldeb").Value
colfin = Range("colfin").Value
lignedeb = Range("lignedeb").Value
lignefin = Range("lignefin").Value
onglet = Range("onglet").Value
autofin = False
If lignefin = "" Then autofin = True
dimTab = 0
If Range("debentete").Value <> "" Then
dimTab = (Cells(Range("debentete").Row, Range("debentete").Column - 1).End(xlToRight).Column - Range("debentete").Column + 1)
ReDim TabEnTete(dimTab - 1)
For i = 0 To UBound(TabEnTete)
TabEnTete(i) = Cells(Range("debentete").Row, Range("debentete").Column + i).Value
Next i
End If
' effacement des données
Worksheets("compilation").Activate
ActiveCell.Offset(rowOffset:=1).Activate
Selection.ClearContents
' place le curseur au début
Range("A2").Offset(0, dimTab).Select
depuis = ActiveCell.Row
' lecture du répertoire
MsgBox "Début de la compilation ..."
ListeFichiers MonRepertoire
MsgBox "Fin de la compilation ..."
End Sub
Sub ListeFichiers(Repertoire As String)
If Repertoire = "" Then
MsgBox " Choisissez le répertoire !"
Exit Sub
End If
Dim Fso, SourceFolder, SubFolder, fichier As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(Repertoire)
' boucle sur tous les fichiers du répertoire
For Each fichier In SourceFolder.Files
If Right(fichier.Name, 4) = ".xls" Or Right(fichier.Name, 5) = ".xlsx" Or Right(fichier.Name, 5) = ".xlsm" Then
If Left(fichier.Name, 2) <> "~$" Then
Workbooks.Open Filename:=Repertoire & "\" & fichier.Name
If FeuilleExiste(onglet) Then
Sheets(onglet).Select
' trouve la dernière ligne
Range(coldeb & (lignedeb - 1)).End(xlDown).Select
If autofin Then lignefin = ActiveCell.Row
' sélectionne la région à copier
Range(coldeb & lignedeb & ":" & colfin & lignefin).Select
' copie la région
Selection.Copy
' change de fichier
destinataire.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
If Range("debentete").Value <> "" Then
For i = 0 To UBound(TabEnTete)
Windows(fichier.Name).Activate
Range(TabEnTete(i)).Copy
destinataire.Activate
Range("A" & depuis & ":" & "A" & (depuis + lignefin - lignedeb)).Offset(0, i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Next i
End If
End If
' ferme le fichier sans faire de changement
Windows(fichier.Name).Activate
ActiveWindow.Close
' place le curseur sous les données
destinataire.Activate
Cells(depuis + lignefin - lignedeb + 1, dimTab + 1).Select
' sauvegarde cette ligne pour recopie des en-têtes en colonne
depuis = ActiveCell.Row
If Range("pasapas").Value = "OUI" Then
MsgBox ("Fin de recopie de """ & fichier.Name & """ : " & lignefin - lignedeb + 1 & " lignes recopiées !")
End If
Else
MsgBox "La feuille """ & onglet & """ du fichier """ & fichier.Name & """ est nouvelle et ne sera pas reprise !"
End If
End If
Next fichier
' appel récursif pour les sous-répertoires
For Each SubFolder In SourceFolder.subfolders
ListeFichiers SubFolder.Path
Next SubFolder
End Sub
Function FeuilleExiste(NomFeuille As String) As Boolean
On Error GoTo Err_FeuilleExiste
FeuilleExiste = False
FeuilleExiste = Not ActiveWorkbook.Worksheets(NomFeuille) Is Nothing
Err_FeuilleExiste:
End FunctionMais sous mac il y a le problème des "ActiveX" qui sont une composante de windows et qui par conséquent ne fonctionnent pas sous mac.
Et je n'arrive pas à contourner le problème.
L'erreur à laquelle je fais face est la suivante:
Et le message suivant s'affiche :
"Erreur 429, un composant ActiveX ne peut pas créer d'objet"
Voila j'espère que l'un de vous sait comment contourner ce problème !
Merci d'avance
