Dégraissez le mammouth test macro

Bonjour à tous,

Pour fichier anormalement "Lourd"

Avant diffusion dans "Applications Excel"

Pourriez-vous tester et me donner votre avis sur ces 2 nouvelles macros ?

---- Nouveauté ----

création d'un rapport de fichier

ce qui permet de voir rapidement les anomalies éventuelles de chaque feuilles.

Toutes suggestions seront appréciées.

Bonne journée

Claude

93mammouth-essai.zip (33.96 Ko)

Bonjour Claude

1ère constatation : la macro ne fonctionne pas sur feuille protégée (arrêt du code)

2ème constatation : sur le fichier joint la macro compte 13 objets ; or, il n'y en a pas (atteindre ==> cellules ==> objets = Aucun objet trouvé)

49test-mammouth.zip (29.47 Ko)

Amicalement

Nad

Bonjour Nad,

Merci pour ta réactivité,

en effet le

x = ActiveSheet.Shapes.Count

comptabilise également les commentaires (qui ne sont pas source recherchée ici)

Il faudrait donc un code qui ne compte que les objets(forme,image)

çà doit se trouver, je cherche !!

pour la protection c'est déjà moins compliqué, si on connait le code, on peut tout déprotéger

et re-protéger à la fin.

à suivre

Amicalement

Claude

édit: remplacer

x = ActiveSheet.Shapes.Count

par

x = ActiveSheet.DrawingObjects.Count

çà à l'air de fonctionner

Claude

Salut claude, nad, forum,

Une petite remarque :

Aux lignes :

    L = Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
    C = Cells.Find("*", , , , xlByColumns, xlPrevious).Column + 1

Imagine que la dernière ligne non vide soit la 65536è (pour excel 2003), ou que la dernière colonne non vide soit la dernière de la feuille. Tu auras une erreur aux lignes suivantes :

    L2 = Rows(L).End(xlDown).Row
    C2 = Columns(C).End(xlToRight).Column

Bonjour et merci vba-new,

Très juste ! à cause du +1

Je pense y avoir remédier sur cette version.

Pour test, j'ai utilisé la cellule IV16 sur feuille "Accueil" avec message d'avertissement

Reste à voir pour la protection, je regarde :

  • entrer le mot de passe (sur un InputBox)
  • tester si feuille est protégée
  • si oui, déprotéger
et autre macro pour re-protéger

Le problème est que maintenant je ne peux plus mettre çà en macro "Perso"

une idée ?

Comme quoi ce poste n'était pas inutile

à suivre

Claude

Bonjour à tous,

Nouvelle version à tester (compte tenu des remarques de Nad et vba-new)

Afin d'éviter la lourdeur de l'opération,

  • J'ai supprimé les messages Continuer Oui/Non
  • Pour les objets, on ne traite qu'au-delà de 10 objets par feuille

Pour les feuilles protégées, je n'ai pas trouvé d'autre solution que de demander le mot de passe,

le stocker sur la feuille temporaire "RapportFichier" en A1

et de déprotéger dans la boucle feuilles.

Il faudra donc reprotéger après l'opération.

Ce point serait peut-être à revoir ?

J'ai cherché sans trouver, un code qui testerait si le classeur contient des feuilles protégées !

ou un autre qui testerait si la feuille active est protégée (dans la boucle).

Reste à voir si les Private Sub événementiels ne vont pas perturber l'opération ?

L'avantage de la feuille "Rapport", c'est qu'on voit de suite les "grosses anomalies".

Je suis tout ouïe à vos suggestions et remarques,

bonne journée

Amicalement

Claude.

31mammouth-rapide.zip (33.95 Ko)

Bonjour à tous,

Je continue les tests,

Nouvelle version "Mammouth_rapide_2.xls"

Toujours à l'écoute de vos remarques

édit: peut-être ajouter dans le rapport le nombre de formats en mémoire

(si quelqu'un connait le code ?), ou autres "bouffe-mémoire" !

Amicalement

Claude

Bonjour,

Dans la macro Menage Analyse, la partie de code

For i = 2 To Worksheets.Count
    Lg = .Range("b65536").End(xlUp)(2).Row 'feuille Rapport
    Worksheets(i).Activate
    '--- évite erreur si feuille vide ---
    On Error Resume Next
        L= Cells.Find("*", , , , xlByRows, xlPrevious).Row
        C = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    On Error GoTo 0
    '---
        x = ActiveSheet.DrawingObjects.Count
    .Cells(Lg, 2) = Worksheets(i).Name
    .Cells(Lg, 3) = L
    .Cells(Lg, 4) = C
    .Cells(Lg, 5) = x
    L = 0: C = 0    'réinitialise si Error Resume Next
Next i

peut être celle-ci

For i = 2 To Worksheets.Count
    Lg = .Range("b65536").End(xlUp)(2).Row 'feuille Rapport
    '--- évite erreur si feuille vide ---
    On Error Resume Next
        L = Worksheets(i).Cells.Find("*", , , , xlByRows, xlPrevious).Row
        C = Worksheets(i).Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    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
Next i

Amicalement

merci Dan,

ok pour supprimer le

Worksheets(i).Activate

mais pour

L = 0: C = 0    'réinitialise si Error Resume Next 

il faut conserver cette ligne, car si feuille vide au milieu des onglets => erreur à:

L = Cells.Find("*", , , , xlByRows, xlPrevious).Row

et le "L" reste à la ligne de la feuille précédente, donc erroné.

Quand je te disais que j'ai galéré sur ce point !

Je vais y aller sur la pointe des pieds pour tester les modifs.

Claude

re,

il faut conserver cette ligne, car si feuille vide au milieu des onglets => erreur à:

Claude, regarde le code que je t'ai modifié, tu verras que comme cela tu n'as pas besoin de remettre L = 0 et C = 0.

Amicalement

re Dan,

J'ai testé ton code mais çà ne change rien,

si tu retire cette ligne, le résultat est faux sur feuille vide

L = 0: C = 0    'réinitialise si Error Resume Next

Fais le test sur mon fichier "Mammouth_rapide_2.xls"

tu verras que la feuille vide reprend les lignes de la Feuil3

ou alors y-a un truc qui m'échappe !

édit: pour "Menage_Go"

Sheets(i).Activate
Application.ScreenUpdating = True
Application.ScreenUpdating = False

si tu retire le True, tu ne vois pas à l'écran la feuille concernée !

çà m'est revenu

Claude

Re,

si tu retire cette ligne, le résultat est faux sur feuille vide

Ok, tu peux le laisser avant Next i, comme cela on réinitialise à chaque passage. Si Erreur L et C seront à 0.

Le code devient :

For i = 2 To Worksheets.Count
Lg = .Range("b65536").End(xlUp)(2).Row 'feuille Rapport
'--- évite erreur si feuille vide ---
On Error Resume Next
    L = Worksheets(i).Cells.Find("*", , , , xlByRows, xlPrevious).Row
    C = Worksheets(i).Cells.Find("*", , , , xlByColumns, xlPrevious).Column
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
    L = 0: C = 0
Next i

si tu retire le True, tu ne vois pas à l'écran la feuille concernée !

Edit : Ok je pense voir de quoi tu parles

A te relire

Reedit : de mon coté, si on enlève les deux instructions Screenupdating (True et False), les feuilles sont bien affichées. explique moi ton souci à ce sujet.

Re,

On est d'accord,

J'ai déplacé les boutons et fais les modifs.

Ce qui pourrait être intéressant, serait de coder pour avoir :

  • le nombre de noms dans le gestionnaire de noms (voir valides et non valides)
  • le nombre de formats personnalisés
édit: les liaisons aussi

çà avance !

Amicalement

Claude

Bonjour à tous,

Pour détecter les noms/définis, on pourrait utiliser ce code,

mais pour ceux qui sont erronés (le if), je ne sais pas coder !

Sub essai2() 'rapport Analyse Mammouth
Dim Nms As Name, Cpt%
        '---- compte les Noms/définis erronés (#REF!) ----
        For Each Nms In Names
            'If IsError(Address(Nms.Name)) Then Cpt = Cpt + 1
        Next Nms
    Range("a1") = Names.Count & " noms" 'total noms ok
    Range("a2") = Cpt & " noms Faux"
End Sub

Une idée ?

Amicalement

Claude

Salut claude,

Pour détecter les noms erronés, tu peux faire comme ça :

    Sub essai2() 'rapport Analyse Mammouth
    Dim Nms As Name, Cpt%
            '---- compte les Noms/définis erronés (#REF!) ----
           For Each Nms In Names
                If InStr(Nms.Value, "#REF!") > 0 Then Cpt = Cpt + 1
           Next Nms
        Range("a1") = Names.Count & " noms" 'total noms ok
       Range("a2") = Cpt & " noms Faux"
    End Sub

Le "> 0" n'est pas obligatoire mais c'est pour mieux comprendre le code.

Bonsoir vba-new,

Très bon çà !

à nous tous, on va pouvoir aboutir à quelque chose de "pas mal"

ce dernier point est ajouté dans cette version,

le bouton "Continuer" supprime les noms erronés.

Resterait à voir les possibilités pour :

  • les liaisons
  • les formats personnalisés "abusifs" (nombre total de formats perso.)
ou d'autres idées ? sans tomber dans la lourdeur.

Merci de ta participation

Amicalement

Claude

Bonjour Claude,

Pour les liaisons il existe un petit programme ("Find Link") qui permet de faire cela. IL s'agit d'une macro de type XLA. Le programme a été réalisé par Bill Manville depuis plusieurs années mais est mis à jour réguliérement.

Sinon

  • dans la macro Sub Menage_Analyse(), tu as deux fois l'instruction -> Application.DisplayAlerts = False
  • la partie de code
.Buttons.Add(500, 15, 80, 25).Select
  With Selection
        .Characters.Text = "Continuer"
        .OnAction = "Mammouth_rapide_4.xls!Menage_Go"
  End With

peut être rémplacée par :

with .Buttons.Add(500, 15, 80, 25)
        .Caption = "Continuer"
        .OnAction = "Menage_Go"
End With

- Dans la macro Menage_Go, tu as toujours les deux instructions Application.ScreenUpdating. Pour moi l'instruction à TRUE ne sert pas puisqu'il n'y a aucune interaction entre les deux macro et que lorsque tu sors d'une procédure, elle est toujours à True. Je laisserais uniquement l'instruction False.

Je vais voir pour te proposer une version avec quelques trucs intéressants...

Amicalement

Bonjour Dan, forum,

Ok pour les boutons, c'est + propre et sera en place sur la prochaine version.

dans la macro Sub Menage_Analyse(), tu as deux fois l'instruction -> Application.DisplayAlerts = False

??? je n'en vois qu'une !

Dans la macro Menage_Go, tu as toujours les deux instructions Application.ScreenUpdating. Pour moi l'instruction à TRUE ne sert pas puisqu'il n'y a aucune interaction entre les deux macro et que lorsque tu sors d'une procédure, elle est toujours à True.

apparemment nos ordi. ne réagissent pas pareil !

là, je ne sors pas de la procédure puisque je suis dans une boucle à False, si je ne remet pas un True on ne vois

pas la feuille,

si çà choque vraiment, on peut mettre cette ligne à la fin :

        Application.ScreenUpdating = True
        Application.Goto Range("a1"), Scroll:=True
        MsgBox (Worksheets(i).Name & " :  nettoyée")
    Next i

à suivre

Bonne journée

Claude

Re,

voilà quelques changements sur le fichier. Une barre d'outils spéciale permet de faire les actions. Avant d'aller plus loin vois si cela te convient.

Amicalement

Bonjour à tous,

Dan,

Ta proposition de barre d'outil est bien mais n'apporte rien de plus au programme,

je la garde sous le coude pour le moment.

----- Petit rappel -----

J'ai ouvert ce poste pour remédier à 2 ou 3 bugs,

avec votre aide, on a pu ajouter quelques options

  • Dé protection des feuilles si besoin
  • Détection des objets, uniquement les "Shapes" (boutons, formes, images)
  • Nettoyage du gestionnaire de noms
et surtout une convivialité et rapidité accrues.

Ce petit outil n'a pas la prétention de régler tous les problèmes, il donne une vue rapide sur

le contenu du classeur.

Si un petit coup de "Mammouth" ne suffit pas à réduire sensiblement le poids de votre fichier,

il faudra prendre des mesures plus radicales comme:

  • Supprimer toutes les bordures et reformater en "propre"
  • Revoir les formules qui s'étendent + que nécessaire
  • Supprimer les formats de cellule personnalisés "farfelus" etc...

Et si tout çà ne suffit toujours pas, recopier les données dans un nouveau classeur.

ou utiliser d'autres programmes de nettoyage (voir macros complémentaires signalées par Dan)

Pour info: avec 500 Ko on à déjà un beau fichier, au delà de 1 Mo, mon avis est que le projet

est mal conçu dans son ensemble.

Dernier conseil: surveiller régulièrement et souvent le poids du fichier, stopper dès qu'il

augmente anormalement et voir le pourquoi.

Je laisse encore un peu le poste ouvert et refais un contrôle général des macros.

Il sera toujours temps de compléter sur une nouvelle version, pour l'instant je vais en resté là

et voir ce que çà donne à l'usage.

Après contrôle, je remets une version sur "Applications Excel"

Merci à tous ceux qui m'ont aidé sur ce coup.

Amicalement

Claude.

Rechercher des sujets similaires à "degraissez mammouth test macro"