Discussion :

[vivi4561]

Bonjour,

En cherchant sur le net j'ai trouvé une fonction permettant de "nettoyer" un fichier excel de toutes ces cellules vides non utilisées. Voici le code (qui est bien connu ...)
:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
Dim Avant As Double, plage As Range
Dim MemVisible
On Error Resume Next
Calc = Application.Calculation ' ---- mémorisation de l'état de recalcul
'------------------------------------------------------------
MsgBox "Pour le classeur actif : " _
& Chr(10) & ActiveWorkbook.FullName _
& Chr(10) & "dans chaque feuille de calcul" _
& Chr(10) & "recherche la zone contenant des données," _
& Chr(10) & "réinitialise la dernière cellule utilisée" _
& Chr(10) & "et optimise la taille du fichier Excel", _
vbInformation, _
"d'après LL par GeeDee@m6net.fr"
'-------------------------------------------------------------
MsgBox "Taille initiale de ce classeur en octets" _
& Chr(10) & FileLen(ActiveWorkbook.FullName), _
vbInformation, ActiveWorkbook.FullName
'------------------------------------------------------------
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours..."
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = True
End With
'-------------------- le traitement
For Each Sht In Worksheets
' Si la feuille est masquée
MemVisible = Sht.Visible
If Sht.Visible <> xlSheetVisible Then Sht.Visible = xlSheetVisible
'
Avant = Sht.UsedRange.Cells.Count
Application.StatusBar = Sht.Name & "-" & Sht.UsedRange.Address
'-------------------Traitement de la zone trouvée
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
'----------------Suppression des lignes inutilisées
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Delete
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2)
'----------------Suppression des colonnes inutilisées
If Not DCell Is Nothing Then Sht.Range(DCell, Sht.[IV1]).EntireColumn.Delete
End If
Rien = Sht.UsedRange.Address
End If
'ActiveWorkbook.Save
'---------------------Message pour la feuille traitée
MsgBox "Nom de la feuille de calcul :" _
& Chr(10) & Sht.Name _
& Chr(10) & Format(Sht.UsedRange.Cells.Count / Avant, "0.00%") _
& " de la taille initiale", _
vbInformation, ActiveWorkbook.FullName
'
Sht.Visible = MemVisible
Next Sht
'--------------------Message fin de traitement
MsgBox "Taille optimisée de ce classeur en octets " & Chr(10) _
  & FileLen(ActiveWorkbook.FullName), vbInformation, _
  ActiveWorkbook.FullNameActive
'--------------------
Application.StatusBar = False
Application.Calculation = Calc
End Sub

Tout ça marche très bien mais je souhaiterai pouvoir mettre ce code dans mon fichier et qu'il ne scrute pas tous les onglets mais juste l'onglet où je fais appel à cette fonction.
J'ai tenté de modifié le fichier en enlevant la partie suivante mais cela ne marche pas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
For Each Sht In Worksheets
' Si la feuille est masquée
MemVisible = Sht.Visible
If Sht.Visible <> xlSheetVisible Then Sht.Visible = xlSheetVisible
'
Avant = Sht.UsedRange.Cells.Count
Application.StatusBar = Sht.Name & "-" & Sht.UsedRange.Address

Savez vous comment je pourrais adapter ce code ?

En vous remerciant,


Vincent

[CodeFacile]

Bonjour,

peux être que j'ai pas compris la question , mais si tu veux que l'exécution soit faite sur un seul onglet , tu supprimes le for each ..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
 
'   A supprimer  For Each Sht In Worksheets
 
if activesheet.name = "Feuil1" then 
 
end if

idem si tu veux le lancer à la demande pour le seul onglet actif : tu peux remplacer le Sht. par activesheet

Application.StatusBar = activesheet.Name & "-" & activesheet.UsedRange.Address