pb d'utilisation du code "reconstruit"

  • Initiateur de la discussion Initiateur de la discussion gpa
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

G

gpa

Guest
Bonjour,

J'essaie désespément d'alléger un fichier xls qui est passé de 4 à 12Mo sans raison identifiée :-(.

J'ai un pb avec la mise en oeuvre de cette macro et je souhaiterais qqs explications sur son utilisation :
-si je saisis le code tel quel, la macro n'apparait pas sous excel (il faut supprimer "NomClasseur$" après "Reconstruit"
-le message "Le classeur à reconstruire doit être ouvert... "s'affiche alors que mon classeur est ouvert

Merci bcp de votre aide,


Sub Reconstruit(NomClasseur$) 'Frédéric Sigonneau, MPFE
'le projet du classeur ne doit pas être protégé
Dim Wbk As Workbook, Chemin$, tmpNom$, Nom$
Dim Projet, i&, Module$

On Error Resume Next
Set Wbk = Workbooks(NomClasseur)
On Error GoTo 0
If Wbk Is Nothing Then
MsgBox "Le classeur à reconstruire doit être ouvert..."
Exit Sub
End If

'dossier temporaire pour l'exportation des modules de code
Chemin = Wbk.Path & "\tempExport"
MkDir Chemin: Chemin = Chemin & "\"

'export des modules
Set Projet = Wbk.VBProject
With Projet
For i = 1 To .VBComponents.Count
Select Case .VBComponents(i).Type
Case 1:
.VBComponents(i).Export Chemin & .VBComponents(i).Name & ".bas"
Case 2:
.VBComponents(i).Export Chemin & .VBComponents(i).Name & ".cls"
Case 3:
.VBComponents(i).Export Chemin & .VBComponents(i).Name & ".frm"
End Select
Next
End With

'export des feuilles dans un nouveau classeur
tmpNom = Left(NomClasseur, Len(NomClasseur) - 4) & "_Refait.xls"
Wbk.Sheets.Copy
ActiveWorkbook.SaveAs Wbk.Path & "\" & tmpNom

'réimport des modules dans le nouveau classeur
Module = Dir(Chemin & "*.*")
Do While (Len(Module) > 0)
On Error Resume Next
Workbooks(tmpNom).VBProject.VBComponents _
.Import(Chemin & Module).Name = Module
On Error GoTo 0
Kill Chemin & Module
Module = Dir()
Loop

'enregistrement et nettoyage
Workbooks(tmpNom).Close True
RmDir Chemin

'remplacement de l'ancien fichier par le nouveau
If MsgBox("Donner au fichier reconstruit le nom du fichier " & _
"d'origine et détruire ce dernier ?", vbYesNo) = vbYes Then
Chemin = Wbk.Path & "\": Nom = Wbk.Name
Wbk.Close False
Kill Chemin & Nom
Name Chemin & tmpNom As Chemin & Nom
End If

End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
800
Réponses
3
Affichages
773
Réponses
8
Affichages
1 K
Retour