Autres Problème de compatibilité Excel 97-2003

[AudreyLa]

Bonjour,

J'utilise une macro pour compiler des fichiers dans un seul fichier mais cette macro est ancienne et deviens très instable. Je n'arrive parfois plus à l'ouvrir elle plante immédiatement.

De plus actuellement je dois convertir tous mes fichiers sous excel 97-2003, je préfèrerais les enregistrer sous format excel classique. Sinon cela m'indique qu'il n'y a aucun fichier. Mais encore une fois, je n'ai pas réussi à comprendre ce qui clochait dans la macro...

Bon après je ne suis pas hyper douée, j'arrive en reprenant des bout dans des tutos à faire des petites macro, mais mon niveau est vraiment très faible...

Est-ce que quelqu'un pourrait m'aider ?

Ma version d'Excel : Microsoft Office LTSC Professionnel Plus 2021

 

[wDog66]

Bonjour,

Perso je n'ai pas compris ce que vous voulez

Le classeur ne contient aucune macro sur l'évènement "Workbook_Open" donc il n' y a pas de raison que le classeur plante à son ouverture à moins d'une corruption du fichier (mais rien constaté)

 

[crocrocro]

Bonjour le fil, bonjour Audrey
@AudreyLa :
le fichier que vous avez joint semble être le résultat d'une recherche abandonnée en cours :
Aucun bouton ou autre pour lancer la macro Appel.
Sur la sélection du répertoire, si le 1er fichier trouvé n'est pas avec l'extension ".xls", message d'erreur et c'est terminé !
je me suis arrêté là.
Le code du module de votre fichier

'---- Exécuter la procédure Appel ----
Sub Appel()
Dim FL1 As Workbook, Chemin As String
Const ssfTous = &H1
Dim objShell As Object, objFolder As Object, oFolderItem As Object
  
ActiveWorkbook.Sheets("Recap").Activate
Range("A1:AA100000").Select
Selection.ClearContents
Range("A1").Select
    
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", ssfTous)
    Set oFolderItem = objFolder.Items.Item
    Chemin = oFolderItem.Path
    Set objShell = Nothing
    Set objFolder = Nothing
    Set oFolderItem = Nothing
    Application.ScreenUpdating = False
        Set FL1 = ThisWorkbook
        Ouvrir Chemin, FL1
    Application.ScreenUpdating = True
    If msg = "" Then
        MsgBox "Copie des fichiers terminée, sans souci."
    Else
        MsgBox "Pour des raisons de protection ou autres, n'ont pu être copiés :" & vbCrLf & msg
    End If
    ActiveWorkbook.Worksheets("feuil1").Activate
End Sub
'---- Ouverture des fichiers ----
Sub Ouvrir(Chemin As String, FL1 As Workbook)
Dim NomFich As String
    NomFich = Dir(Chemin & "\")
    'If NomFich = "" Or Right(NomFich, 4) <> ".xls" Then
         MsgBox "Aucun fichier trouvé dans " & Chemin & "."
         Exit Sub
    End If
    Do While NomFich <> ""
        Application.EnableEvents = False
            Workbooks.Open Chemin & "\" & NomFich
            DoEvents
        Application.EnableEvents = True
        NomFich = ActiveWorkbook.Name
        Copie NomFich, FL1
        NomFich = Dir
    Loop
End Sub
'---- Copie des feuilles ----
Sub Copie(NomFich As String, FL1 As Workbook)
    Application.EnableEvents = False
        For Each LaFeuille In Workbooks(NomFich).Worksheets
            'MsgBox LaFeuille.Name
            On Error Resume Next
            LaFeuille.Copy After:=FL1.Sheets(FL1.Sheets.Count)
            DoEvents
            If ActiveSheet.Protect = True Then ActiveSheet.Unprotect
            ActiveSheet.UsedRange.Copy
            ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
            If Err <> 0 Then
                msg = msg & "Classeur " & NomFich & " feuille " & LaFeuile.Name & vbCrLf
                Err.Clear
                On Error GoTo 0
            End If
            DoEvents
            If Cpt Mod 200 = 0 Then
                ThisWorkbook.Save
                DoEvents
            End If
        Next
    Application.EnableEvents = True
    'Fermeture du classeur
    Application.DisplayAlerts = False
        Workbooks(NomFich).Close False
    Application.DisplayAlerts = True
    DoEvents

Call RegroupeFeuilles   'dans Récap"
End Sub
'---- Regrouper les onglets ----
Sub RegroupeFeuilles() 'dans Récap"
Dim Lg&, Sh As Worksheet, f As Worksheet
        Set f = Sheets("Récap")
    f.Range("a1:k" & f.[a65000].End(xlUp).Row).ClearContents    'efface Récap
  
    For Each Sh In Worksheets
        If Sh.Name <> f.Name And Sh.Name <> "Feuil1" Then         'feuilles à ne pas traiter
            Lg = Sh.Range("a" & Rows.Count).End(xlUp).Row
            Sh.Range("a1:k" & Lg).Copy Destination:= _
            f.Range("a" & Rows.Count).End(xlUp)(2)
        End If
    Next

End Sub

EDIT : je n'avais pas vu la réponse de @wDog66
Je n'ai pas non plus précisé qu'il y avait des liens externes ... que j'ai supprimées

 

[AudreyLa]

Bonjour,

Merci @crocrocro & @wDog66
Je vais essayer de comprendre les différences.
En fait je viens de comprendre j'avais copier la macro du fichier initial dans un nouveau fichier car je ne pouvais pas vous téléverser l'ancien (15mo) mais j'ai oublié de rattacher les boutons à la macro de cette feuille

Merci en tout cas !

 

[crocrocro]

@AudreyLa :
Un conseil, décrivez le plus précisément possible ce que vous voulez.
Ceux qui répondent adapteront le code ou proposeront un nouveau code.
EDIT :
Quelques réflexions qui peut-être vous aiderons dans vos compléments d'informations :
Doit-on exclure ou non les fichiers Excel avec macros (extension xlsm pour les versions récentes) ?
Si la réponse est non, la copie actuelle ne concernant que les feuilles, que faire du code des modules des feuilles, les userforms ... ?
Je n'ai pas testé, mais si les feuilles compilées ont des noms (gestionnaire de noms) identiques avec des portées "Classeur", Excel fera-t-il son choix pour en désigner une (la1ère ?) de niveau Classeur et les autres de niveau Feuille ?
De toute façon, au final,il y aura des surprises au niveau résultat.