Dégraissez le mammouth
Bonjour,
En 2011, user Dubois a mis à jour une macro appelée Mammouth_rapide_V6.xls. J'apprécierais beaucoup si quelqu'un pouvait m'indiquer la procédure à suivre pour utiliser cette macro.
J'ai sûrement le même problème avec un de mes fichiers. Je suis débutant sur Excel, je n'ai jamais utiliser de macros, j'utilise des formules très simples. J'ai téléchargé le fichier mentionné plus haut mais je n'ai aucune idée comment transférer les macros dans mon fichier. D'ailleurs, je ne vois pas de code dans ce fichier. Vous pouvez maintenant comprendre mon ignorance. Est-ce que quelqu'un peux m'expliquer étape par étape comment je peux copier ces macros dans mon fichier et par la suite, comment les utiliser.
Merci à l'avance
Paul
Il est caché où le mammouth ?
Bonjour polaire
bonjour steelson
Loureed me l'avais donné il y a quelque temps en explicant le fonctionnement voir le sujet suivant
Fred
Tu peux faire (à tester) :
Alt+F11
Insérer module
Copier ceci
Option Explicit
'Macros par Claude Dubois pour "Excel-Pratique"
'le 07 Janv 2011 -- Ajout comptage des MFC
Sub Menage_Analyse()
Dim Lg%, Rep$, i&, L&, C&, DerCel
Dim Sh As Worksheet, Nms As Name, Cpt%, Cpt2%
Application.ScreenUpdating = False
'----- contrôle si feuilles protégées -----
For Each Sh In Sheets
If Sh.ProtectContents Then 'merci cousinhub
Cpt = Cpt + 1
End If
Next Sh
'----- si feuilles protégées, déprotège -----
If Cpt > 0 Then
Rep = InputBox("Ce classeur contient " & Cpt & " feuille(s) protégée(s)" & Chr(10) & _
"entrez le mot de passe pour déprotéger" & Chr(10) & Chr(10) & _
"Si protection sans mot de passe, tapez un caractère quelconque")
If Rep = "" Then Exit Sub
For Each Sh In Sheets
If Sh.ProtectContents Then
On Error GoTo Fin '#### mot de passe non valide
Sh.Unprotect Password:=Rep
End If
Next Sh
End If
'---- compte les Noms/définis erronés (#REF! et #N/A) ----
For Each Nms In Names
If InStr(Nms.RefersTo, "#REF") Then Cpt = Cpt + 1
If InStr(Nms.RefersTo, "#N/A") Then Cpt2 = Cpt2 + 1
Next Nms
'----- création feuille rapport -----
Sheets(1).Activate
On Error Resume Next
Application.DisplayAlerts = False
Sheets("RapportFichier").Delete
On Error GoTo 0
Sheets.Add.Name = "RapportFichier"
With Sheets("RapportFichier")
.Cells(1, 1) = "Gestionnaire de noms"
.Cells(1, 2) = "Feuilles"
.Cells(1, 3) = "Lignes utilisées"
.Cells(1, 4) = "Colonnes utilisées"
.Cells(1, 5) = "Nombre d'objets"
.Cells(1, 6) = "Adresse DerCel"
.Cells(1, 7) = "Nbre MFC"
'----- création boutons "Continuer" "Annuler" -----
With .Buttons.Add(500, 15, 80, 25)
.Caption = "Continuer"
.OnAction = "Menage_Go"
End With
With .Buttons.Add(500, 60, 80, 25)
.Caption = "Annuler"
.OnAction = "Menage_Annuler"
End With
'----- Analyse ------
For i = 2 To Worksheets.Count
Lg = .Range("b65536").End(xlUp)(2).Row 'feuille Rapport
'--- évite erreur si feuille vide ---
On Error Resume Next
Worksheets(i).ShowAllData 'libère les filtres
L = Worksheets(i).Cells.Find("*", , , , xlByRows, xlPrevious).Row
C = Worksheets(i).Cells.Find("*", , , , xlByColumns, xlPrevious).Column
DerCel = Worksheets(i).Cells.SpecialCells(xlCellTypeLastCell) _
.Address(RowAbsolute:=False, ColumnAbsolute:=False, ReferenceStyle:=xlA1, _
RelativeTo:=Worksheets(i).Cells(1, 1))
On Error GoTo 0
'---
.Cells(Lg, 2) = Worksheets(i).Name
.Cells(Lg, 3) = L
.Cells(Lg, 4) = C
.Cells(Lg, 5) = Worksheets(i).DrawingObjects.Count
.Cells(Lg, 6) = DerCel
.Cells(Lg, 7) = Worksheets(i).Cells.FormatConditions.Count
L = 0: C = 0 'réinitialise si Error Resume Next
Next i
.Activate
.Range("a:g").Columns.AutoFit
.Range("c:g").HorizontalAlignment = xlCenter
.Range("a1:g1").Interior.ColorIndex = 15
.Range("a2") = Names.Count & " noms" 'total noms
.Range("a3") = Cpt & " noms Faux"
.Range("a4") = Cpt2 & " noms #N/A"
End With
Exit Sub
Fin: MsgBox ("mot de passe non valide !")
End Sub
Sub Menage_Go()
'Macros par Claude Dubois pour "Excel-Pratique" le 07 Janv 2011
Dim Rep%, i%, x%, L&, C&, L2&, C2&, Nms As Name
'---- supprime les Noms/définis erronés (#REF! et #N/A) ----
For Each Nms In Names
If InStr(Nms.RefersTo, "#REF") Then Nms.Delete
'If InStr(Nms.RefersTo, "#N/A") Then Nms.Delete '(pas fiable)
Next Nms
'----
For i = 2 To Worksheets.Count
Sheets(i).Activate
Application.ScreenUpdating = False
x = ActiveSheet.DrawingObjects.Count
'---- teste objets si + de 10 ----
If x > 10 Then
Rep = MsgBox(Worksheets(i).Name & " : il y a : " & x & " objets dans cette feuille" & Chr(10) & _
"Voulez-vous supprimer certains objets ?", vbYesNo + vbCritical + vbDefaultButton2, "Suppression objets")
If Rep = vbYes Then
ActiveSheet.Visible = True
Application.ScreenUpdating = True
ActiveSheet.DrawingObjects.Select
MsgBox ("Sélectionnez les objets à conserver avec la touche MAJ enfoncée" & Chr(10) & _
"ensuite, appuyez sur touche < Suppr >" & Chr(10) & _
"les objets indésirables seront supprimés !")
MsgBox ("Après la suppression des objets" & Chr(10) & _
"relancez la macro pour lignes et colonnes.")
Exit Sub
End If
End If
'--- évite erreur si feuille vide ---
On Error Resume Next '####
ActiveSheet.ShowAllData 'libère filtre
If ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row > 1 Then
L = Cells.Find("*", , , , xlByRows, xlPrevious).Row
C = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
On Error GoTo 0 '####
L2 = Rows(L).End(xlDown).Row
C2 = Columns(C).End(xlToRight).Column
'---- supprime lignes en dessous ---- ajouté L+2 (31/07/10)à cause filtres
If L < L2 Then
Range(L + 2 & ":" & L2).EntireRow.Delete
Else: MsgBox (Worksheets(i).Name & " : Cette feuille occupe la dernière ligne en bas !" & Chr(10) & _
"vérifiez si conforme.")
End If
'---- supprime colonnes à droite ---- ajouté C+2 (31/07/10)
If C < C2 Then
Range(Cells(, C + 2), Cells(, C2)).EntireColumn.Delete
Else: MsgBox (Worksheets(i).Name & " : Cette feuille occupe la dernière colonne à droite !" & Chr(10) & _
"vérifiez si conforme.")
End If
End If
Application.ScreenUpdating = True
Application.Goto Range("a1"), Scroll:=True
MsgBox (Worksheets(i).Name & " : nettoyée")
Next i
Application.DisplayAlerts = False
Sheets("RapportFichier").Delete
Sheets(1).Activate
MsgBox ("N'oubliez pas d'enregistrer et de reprotéger vos feuilles")
End Sub
Sub Menage_Annuler()
Application.DisplayAlerts = False
Sheets("RapportFichier").Delete
Sheets(1).Activate
End SubEt pour lancer, Faire Alt+F8
Bravo à LouReeD
Steelson,
Loureed m'avait fourni le fichier de graissez le mammouth.. mais l'auteur de ce fichier est Claude Dubois... qui n'est plus sur le forum ....
(dernière connexion Aout 2012.....)
fred
Merci à vous tous pour cette information intéressante. Il y a seulement une chose de plus que j'aimerais savoir. Je roule avec Windows 10 et Excel 2016. Est-il possible que ça ait changé. Quand je tape Alt et F11, ça diminue l'intensité de mon écran.
Merci encore pour votre réponse.
Cela dépend aussi de ton micro peut-être.
Voire également du fait que tu sois en Majuscules !
Tu peux y accéder directement à partir du ruban d'excel dans ce cas ...
Merci Steelson, comme j'ai mentionné auparavant, mes connaissances de Excel sont très limitées. J'ai eu beau fouiller dans tous les onglets mais je n'ai rien trouvé en rapport à ce que tu dis. Si je comprends bien, quand tu parles du ruban d'Excel , tu veux dire tous les onglets en haut de la feuille (accueil, insertion, mise en page, ...) n'est-ce pas ?
Merci encore pur ton aide.
Bonsoir,
As-u le menu Développeur dans le ruban?
Merci Jean-Eric,
Je n'ai pas l'onglet développeur. Voir dans le fichier joint ce qu'a l'air le ruban d'Excel.
J'ai réussi à copier le macro mais quand je demande de l'exécuter, je reçois le message contenu dans le fichier joint.
Fais "affichage" et c'est tout à droite !
Bonjour,
Tu dois donc ajouter cette commande dans le ruban.
Fichier / Options / Personnaliser le ruban.
Dans la fenêtre de droite (Onglets principaux), tu ajoutes (coches) Développeur.
Cdlt.