Diminuer le poids

Bonjour,
Tu peux en outre enregistrer systématiquement enregistrer les classeurs au
format .xlsb. (si Excel 2007 ou postérieur).
Cordialement.
Daniel
Jacquouille a utilisé son clavier pour écrire :

Bonjour à tous et toutes... et à Denis

Je viens de passer un fichier à la moulinette pour le faire diminuer de
poids.
Il s'agit d'une macro copiée lâchement en ces lieux (5 cm plus bas, dans le
fil intitulé: "Sortir l'auteur d'un fichier").
Ma question:
Est-il possible, intelligent, efficace et non dangereux de passer TOUS les
fichiers Excel avec la moulinette?
Est-il possible, éventuellement, de faire une macro du style:
....pour chaque fichier du disque c
appliquer la macro de Denis

Mon PC devient vieux et asthmatique et quelques Kg en moins ne lui feraient
pas de tort.
Déjà merci
Jacques.

Hé Daniel
Tu étais à l'affut?

Excel 2007, c'est quoi, ça? le 4° millénaire? -))

Jacques 1948, XL2003
Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
-----------------
"DanielCo" a écrit dans le message de groupe de discussion :
mtu08b$sci$1@speranza.aioe.org...

Bonjour,
Tu peux en outre enregistrer systématiquement enregistrer les classeurs au
format .xlsb. (si Excel 2007 ou postérieur).
Cordialement.
Daniel
Jacquouille a utilisé son clavier pour écrire :

Bonjour à tous et toutes... et à Denis

Je viens de passer un fichier à la moulinette pour le faire diminuer de
poids.

---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com

Bonjour Jacques,

:-)))
Non Jacques, il n'y a aucun danger à utiliser une macro de "nettoyage".
J'utilise depuis le temps des dinosaures (XP et Excel... antérieur au tien)
une macro, publiée en son temps par le chef 4 plumes (Laurent Longre) qui
ressemble à celle de Denis, ce qui est normal puisqu'elles font le même
travail.
Cette macro est installée dans ma barre d'outils (depuis 2007 cela s'appelle
ruban) et je l'utilise de temps en temps pour nettoyer (alléger) mes
fichiers. C'est d'autant plus nécessaire que depuis 2007 et 2010 les
fichiers comportent plus de 1 million de lignes et 65 mille colonnes.
J'ajouterai : Denis t'a-t-il déjà fait faire des bêtises ?
Allez, courage ! Prends un seau et une éponge et nettoie-moi tout çà !
Bonne journée
Michel



"Jacquouille" a écrit dans le message de groupe de discussion :
mtu0e2$smk$1@speranza.aioe.org...

Hé Daniel
Tu étais à l'affut?

Excel 2007, c'est quoi, ça? le 4° millénaire? -))

Jacques 1948, XL2003
Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
-----------------
"DanielCo" a écrit dans le message de groupe de discussion :
mtu08b$sci$1@speranza.aioe.org...

Bonjour,
Tu peux en outre enregistrer systématiquement enregistrer les classeurs au
format .xlsb. (si Excel 2007 ou postérieur).
Cordialement.
Daniel
Jacquouille a utilisé son clavier pour écrire :

Bonjour à tous et toutes... et à Denis

Je viens de passer un fichier à la moulinette pour le faire diminuer de
poids.

---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
http://www.avast.com

Bonjour Jacquouille,

Ceci devrait faire le travail pour tous les fichiers du répertoire spécifié dans la procédure
"TEST".

Si tu as plusieurs fichiers, cela peut prendre un certain temps. La procédure doit ouvrir chacun des
fichiers à traiter... Patience!

'--------------------------------------------------------------------------------------
Sub test()
Dim Chemin As String, Fichier As String
Dim ModeCalcul As String

Application.ScreenUpdating = False
ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'***********Variable à définir*************
'Le répertoire que tu veux traiter, ne pas oublier le ""
Chemin = "c:Userston profilDocuments"
'*******************************************

Fichier = Dir(Chemin & "*.xl*")

Do While Fichier <> ""
Call Poids_diminuer(Chemin & Fichier)
Fichier = Dir()
Loop

Application.Calculation = ModeCalcul
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
'--------------------------------------------------------------------------------------

Sub Poids_diminuer(DocName As String)
Dim Sh As Worksheet, DerLig As Long, DerCol As Integer

Set Wk = Workbooks.Open(DocName)

On Error Resume Next
For Each Sh In Wk.Worksheets
With Sh
If Not IsEmpty(.UsedRange) Then
DerLig = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

DerCol = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
.Range(.Cells(1, DerCol + 1), .Cells(.Rows.Count, .Columns.Count)).Delete
.Range(.Cells(DerLig + 1, 1), .Cells(.Rows.Count, .Columns.Count)).Delete
End If
End With
If Err <> 0 Then Err = 0
Next
Wk.Close True
Set Wk = Nothing
End Sub
'--------------------------------------------------------------------------------------

Salut Michel

Non, Denis ne m'a jamais fait faire de bêtise.
Mais, dans ce cas, il parlait d'alléger un fichier bien précis.
Ma question portait plus sur le fait de boucler tout le disque c, ou, à la
limite, un répertoire appelé "machin-truc" dans lequel figurent quelques
tonnes de fichiers Excel.
J'aimerais que WW( réunion tu perds du poids)
Content d'avoir de tes nouvelles.
Bonne journée
Jacques.



Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"Péhemme" a écrit dans le message de groupe de discussion :
mtu1ii$vj1$1@speranza.aioe.org...

Bonjour Jacques,

:-)))
Non Jacques, il n'y a aucun danger à utiliser une macro de "nettoyage".
J'utilise depuis le temps des dinosaures (XP et Excel... antérieur au tien)
une macro, publiée en son temps par le chef 4 plumes (Laurent Longre) qui
ressemble à celle de Denis, ce qui est normal puisqu'elles font le même
travail.
Cette macro est installée dans ma barre d'outils (depuis 2007 cela s'appelle
ruban) et je l'utilise de temps en temps pour nettoyer (alléger) mes
fichiers. C'est d'autant plus nécessaire que depuis 2007 et 2010 les
fichiers comportent plus de 1 million de lignes et 65 mille colonnes.
J'ajouterai : Denis t'a-t-il déjà fait faire des bêtises ?
Allez, courage ! Prends un seau et une éponge et nettoie-moi tout çà !
Bonne journée
Michel



"Jacquouille" a écrit dans le message de groupe de discussion :
mtu0e2$smk$1@speranza.aioe.org...

Hé Daniel
Tu étais à l'affut?

Excel 2007, c'est quoi, ça? le 4° millénaire? -))

Jacques 1948, XL2003
Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
-----------------
"DanielCo" a écrit dans le message de groupe de discussion :
mtu08b$sci$1@speranza.aioe.org...

Bonjour,
Tu peux en outre enregistrer systématiquement enregistrer les classeurs au
format .xlsb. (si Excel 2007 ou postérieur).
Cordialement.
Daniel
Jacquouille a utilisé son clavier pour écrire :

Bonjour à tous et toutes... et à Denis

Je viens de passer un fichier à la moulinette pour le faire diminuer de
poids.

---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
http://www.avast.com


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com

Re bonjour,
Tout d'abord, un grand merci de venir en aide aux souffrants. -)

Ce sal**** de PC m'inscrit la ligne "Call..." en rouge et sélectionne en
bleu le mot Call
Petit msg : Erreur compil et erreur syntaxe....

'***********Variable à définir*************
'Le répertoire que tu veux traiter, ne pas oublier le ""
'Chemin = "c:Userston profilDocuments"
Chemin = "c:UsersPCDesktopFichiers Excel"
'*******************************************

Fichier = Dir(Chemin & "*.xl*")

Do While Fichier <> ""
call Poids_diminuer(Chemin & Fichier)

Fichier = Dir()

Qu'est-ce que j'ai encore fait comme connerie ????

Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"MichD" a écrit dans le message de groupe de discussion :
mtu1vt$105$1@speranza.aioe.org...

Bonjour Jacquouille,

Ceci devrait faire le travail pour tous les fichiers du répertoire spécifié
dans la procédure
"TEST".

Si tu as plusieurs fichiers, cela peut prendre un certain temps. La
procédure doit ouvrir chacun des
fichiers à traiter... Patience!

'--------------------------------------------------------------------------------------
Sub test()
Dim Chemin As String, Fichier As String
Dim ModeCalcul As String

Application.ScreenUpdating = False
ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'***********Variable à définir*************
'Le répertoire que tu veux traiter, ne pas oublier le ""
Chemin = "c:Userston profilDocuments"
'*******************************************

Fichier = Dir(Chemin & "*.xl*")

Do While Fichier <> ""
Call Poids_diminuer(Chemin & Fichier)
Fichier = Dir()
Loop

Application.Calculation = ModeCalcul
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
'--------------------------------------------------------------------------------------

Sub Poids_diminuer(DocName As String)
Dim Sh As Worksheet, DerLig As Long, DerCol As Integer

Set Wk = Workbooks.Open(DocName)

On Error Resume Next
For Each Sh In Wk.Worksheets
With Sh
If Not IsEmpty(.UsedRange) Then
DerLig = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

DerCol = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
.Range(.Cells(1, DerCol + 1), .Cells(.Rows.Count,
.Columns.Count)).Delete
.Range(.Cells(DerLig + 1, 1), .Cells(.Rows.Count,
.Columns.Count)).Delete
End If
End With
If Err <> 0 Then Err = 0
Next
Wk.Close True
Set Wk = Nothing
End Sub
'--------------------------------------------------------------------------------------


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com

Dans ton message précédent, le chemin que tu indiques est probablement pas bon!

Dans l'explorateur de fichiers Windows, tu as dans le haut de la fenêtre, une barre
indiquant le chemin du répertoire courant en cours. Est-ce que le chemin indiqué dans
cette barre est le même que celui indiqué dans la procédure sans oublier de terminer
le chemin par un "" à la fin du chemin dans la procédure. Dans la procédure suivante,
il y a une ligne de code qui vérifie si le chemin existe vraiment.
If Dir(Répertoire, vbDirectory) <> "" Then
Dans ton cas, remplace Répertoire par la variable "Chemin".

La procédure qui suit, traite tous les fichiers "Excel" du répertoire indiqué dabs la procédure
"TEST"
PLUS tous les fichiers Excel des sous-répertoires du répertoire principal.

Il faut éviter de vouloir scanner tout le disque dur!


Option Explicit
'--------------------------------------------------------------------------------
Sub test()
Dim Répertoire As String, MaListe As Variant
Dim Temp(), Elt As Variant, A As Long, ModeCalcul As Long
Dim Sh As Worksheet, Fichier As String

Application.ScreenUpdating = False
ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'Répertoire de départ à définir...
Répertoire = "C:UsersDenisDocuments"

Fichier = Dir(Répertoire & "*.xl*")

On Error Resume Next
If Dir(Répertoire, vbDirectory) <> "" Then
Do While Fichier = ""
Call Poids_diminuer(Répertoire & Fichier)
Fichier = Dir()
Loop

MaListe = ListeDossiers(Répertoire, Temp())
Erase Temp

For Each Elt In MaListe
Fichier = Dir(Répertoire & Elt & "" & "*.xl*")
Do While Fichier <> ""
Call Poids_diminuer(Répertoire & Fichier)
Fichier = Dir()
Loop
Next
Else
Msgbox "Répertoire non valide """ & répertoire & """."
End If

Application.Calculation = ModeCalcul
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'--------------------------------------------------------------------------------
Sub Poids_diminuer(DocName As String)
Dim Sh As Worksheet, DerLig As Long
Dim Wk As Workbook, DerCol As Integer

Set Wk = Workbooks.Open(DocName)

On Error Resume Next
For Each Sh In Wk.Worksheets
With Sh
If Not IsEmpty(.UsedRange) Then
DerLig = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

DerCol = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
.Range(.Cells(1, DerCol + 1), .Cells(.Rows.Count, .Columns.Count)).Delete
.Range(.Cells(DerLig + 1, 1), .Cells(.Rows.Count, .Columns.Count)).Delete
End If
End With
If Err <> 0 Then Err = 0
Next
Application.DisplayAlerts = False
Wk.Close True
Application.DisplayAlerts = True
Set Wk = Nothing
End Sub
'--------------------------------------------------------------------------------

Function ListeDossiers(dossier, Liste())
Dim Fs As Object, F As Object
Dim F1 As Object, Sf As Object, A As Integer
Set Fs = CreateObject("Scripting.FileSystemObject")
Set F = Fs.GetFolder(dossier)
Set Sf = F.SubFolders

For Each F1 In Sf
ReDim Preserve Liste(0 To A)
Liste(A) = F1.Name
A = A + 1
Next
ListeDossiers = Liste
Erase Liste
End Function
'--------------------------------------------------------------------------------

Re
Merci pour ce complément.
Avant de lancer la macro, dois-je ouvrir ou non un fichier qui se trouve
dans le répertoire à faire maigrir?

Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"MichD" a écrit dans le message de groupe de discussion :
mtu6bg$bf4$1@speranza.aioe.org...

Dans ton message précédent, le chemin que tu indiques est probablement pas
bon!

Dans l'explorateur de fichiers Windows, tu as dans le haut de la fenêtre,
une barre
indiquant le chemin du répertoire courant en cours. Est-ce que le chemin
indiqué dans
cette barre est le même que celui indiqué dans la procédure sans oublier de
terminer
le chemin par un "" à la fin du chemin dans la procédure. Dans la procédure
suivante,
il y a une ligne de code qui vérifie si le chemin existe vraiment.
If Dir(Répertoire, vbDirectory) <> "" Then
Dans ton cas, remplace Répertoire par la variable "Chemin".

La procédure qui suit, traite tous les fichiers "Excel" du répertoire
indiqué dabs la procédure
"TEST"
PLUS tous les fichiers Excel des sous-répertoires du répertoire principal.

Il faut éviter de vouloir scanner tout le disque dur!


Option Explicit
'--------------------------------------------------------------------------------
Sub test()
Dim Répertoire As String, MaListe As Variant
Dim Temp(), Elt As Variant, A As Long, ModeCalcul As Long
Dim Sh As Worksheet, Fichier As String

Application.ScreenUpdating = False
ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'Répertoire de départ à définir...
Répertoire = "C:UsersDenisDocuments"

Fichier = Dir(Répertoire & "*.xl*")

On Error Resume Next
If Dir(Répertoire, vbDirectory) <> "" Then
Do While Fichier = ""
Call Poids_diminuer(Répertoire & Fichier)
Fichier = Dir()
Loop

MaListe = ListeDossiers(Répertoire, Temp())
Erase Temp

For Each Elt In MaListe
Fichier = Dir(Répertoire & Elt & "" & "*.xl*")
Do While Fichier <> ""
Call Poids_diminuer(Répertoire & Fichier)
Fichier = Dir()
Loop
Next
Else
Msgbox "Répertoire non valide """ & répertoire & """."
End If

Application.Calculation = ModeCalcul
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'--------------------------------------------------------------------------------
Sub Poids_diminuer(DocName As String)
Dim Sh As Worksheet, DerLig As Long
Dim Wk As Workbook, DerCol As Integer

Set Wk = Workbooks.Open(DocName)

On Error Resume Next
For Each Sh In Wk.Worksheets
With Sh
If Not IsEmpty(.UsedRange) Then
DerLig = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

DerCol = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
.Range(.Cells(1, DerCol + 1), .Cells(.Rows.Count,
.Columns.Count)).Delete
.Range(.Cells(DerLig + 1, 1), .Cells(.Rows.Count,
.Columns.Count)).Delete
End If
End With
If Err <> 0 Then Err = 0
Next
Application.DisplayAlerts = False
Wk.Close True
Application.DisplayAlerts = True
Set Wk = Nothing
End Sub
'--------------------------------------------------------------------------------

Function ListeDossiers(dossier, Liste())
Dim Fs As Object, F As Object
Dim F1 As Object, Sf As Object, A As Integer
Set Fs = CreateObject("Scripting.FileSystemObject")
Set F = Fs.GetFolder(dossier)
Set Sf = F.SubFolders

For Each F1 In Sf
ReDim Preserve Liste(0 To A)
Liste(A) = F1.Name
A = A + 1
Next
ListeDossiers = Liste
Erase Liste
End Function
'--------------------------------------------------------------------------------


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com

C'est de l'automation... tu n'as qu'à lancer la procédure "TEST".
Tu ouvres la fenêtre des macros par le raccourci clavier "Alt + F8"
et tu exécutes la macro "TEST".

Tu peux en outre enregistrer systématiquement enregistrer les
classeurs au format .xlsb. (si Excel 2007 ou postérieur).

Le format xlsb permet en effet de réduire par 10 la taille des fichiers
Excel.

Ses deux inconvénients à ne pas oublier:
1) les xlsb ne sont pas lisibles avec des Excel antérieurs à 2007
2) les xlsb contrairement aux fichiers xls permettent de passer de 65536
lignes à 1048576 lignes et également une belle augmentation du nombre de
colonnes. Ce qui parfois peut poser problème d'alourdissement si, par
exemple, une cellule de la ligne à 1 million se voit appliquer un
format. Le nombre de cellules jugées utilisées explosent et cela
alourdit alors très fortement le fichier... d'où la macro de MichD pour
alléger ça. ;-)

Pour le cas 2, il m'est d'ailleurs déjà arrivé d'avoir un fichier xlsb
énorme sur lequel je ne pouvais pas appliquer la macro pour gagner en
poids en modifiant le nombre de cellules utilisées. J'ai dû passer par
un copier/coller de mon classeur vers un nouveau classeur. Malgrè ce bug
(qui ne m'est arrivé qu'une seule fois) j'enregistre maintenant par
défaut tous mes classeurs Excel en xlsb.

@+
HD