pb d'utilisation du code "reconstruit"

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
 

Discussions similaires

Statistiques des forums

Discussions
312 429
Messages
2 088 352
Membres
103 824
dernier inscrit
frederic.marien@proximus.