Taille anormale, meme apres degraissage du mamouth

bonjour à tous,

j'ai un fichier excel qui fait une taille anormale (quasi 5 mégas), alors même que j'ai tout enlevé.

J'ai travaillé par élimination, en supprimant tous les onglets, et tous les objets, etc... jusqu’à trouver le source de cette taille anormale.

Du coup, j'ai isolé cet onglet, mais impossible de mettre la main sur ce qui fait gonfler le fichier.

j'ai même essayé avec le fameux fichier excel "Dégraisser mon mamouth", mais rien n'y fait. Je désespère.

Est ce que quelqu'un aurait un idee?

très cordialement à tous.

Bonjour

Sur ton fichier, pas grand chose à trouver, à part la feuille frais Notaires qui est masquée

Qu'y à t-il d'anormal? 38,5 Ko pour 2 feuilles et quelques modules

cordialement

Bonjour,

Peux-tu expliquer le nombre important de styles de cellules?

Copie ce code dans un module standard exécute la procédure.

Par précaution, travaille sur une copie de ton fichier pour le test.

A te relire.

Cdlt.

Public Sub StylesKill()
Dim styT As Style
Dim intRet As Long
    For Each styT In ActiveWorkbook.Styles
        ' Cette propriété a la valeur True si le style est un style prédéfini.
        ' Voir aussi TableStyle.Builtin
        If Not styT.BuiltIn Then
            intRet = MsgBox("Delete style : " & styT.Name & "?", vbYesNo)
            If intRet = vbYes Then styT.Delete
        End If
    Next styT
End Sub

ca alors, j'y comprend rien, mon fichier faisait 4.55 megas quand il etait sur le bureau!

je re-regarde plus attentivement cette histoire!

Bonjour,

As-tu effectué ce que j'ai préconisé?

Cdlt.

oui, effectivement, il y a un nombre impressionnant de styles.

je vais regarder ce également.

Y a t-il moyen, dans ton codede mettre les cellules impactees d'un couleur differente?

cdlt

Bonjour,

Pour information, essaie cette procédure. Les cellules dont le style n'est pas prédéfini seront en police bleu et en gras.

Comme précédemment, travaille sur une copie de ton fichier.

Cordialement.

Public Sub DEMO()
Dim wb As Workbook
Dim ws As Worksheet
Dim rCell As Range, rng As Range, Cell As Range

    Application.ScreenUpdating = False
    Set wb = ActiveWorkbook

    For Each ws In wb.Worksheets
        If ws.UsedRange.Address <> "$A$1" Or Not IsEmpty(ws.[A1]) Then
            On Error Resume Next
            Set rCell = ws.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
            If Not rCell Is Nothing Then
                ws.Range(rCell, ws.Cells([A:A].Count, 1)).EntireRow.Clear
                Set rCell = Nothing
                Set rCell = ws.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2)
                If Not rCell Is Nothing Then
                    ws.Range(rCell, ws.[XFD1]).EntireColumn.Clear
                End If
                Set rng = ws.UsedRange
            End If
            On Error GoTo 0
            For Each Cell In rng
                If Not Cell.Style.BuiltIn Then
                    With Cell
                        .Font.Bold = True
                        .Font.Color = vbBlue
                    End With
                End If
            Next Cell
        End If
    Next ws

    Set rng = Nothing: Set rCell = Nothing
    Set wb = Nothing

End Sub

argh,

j'ai bien essayé de tester mais j'ai une erreur d'execution type 424, et qui fait planter excel.

en passant en mode pas a pas, excel s'arrete des la ligne: For Each ws In wb.Worksheets

mon niveau de programmation ne me permet pas d'aller plus loin.

cdlt

Bonjour,

J'ai apporté une correction à la procédure.

Cdlt.

Public Sub DEMO()
Dim wb As Workbook
Dim ws As Worksheet
Dim rCell As Range, rng As Range, Cell As Range

    Application.ScreenUpdating = False
    Set wb = ActiveWorkbook

    For Each ws In wb.Worksheets
        If ws.UsedRange.Address <> "$A$1" Or Not IsEmpty(ws.[A1]) Then
            On Error Resume Next
            Set rCell = ws.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
            If Not rCell Is Nothing Then
                ws.Range(rCell, ws.Cells([A:A].Count, 1)).EntireRow.Clear
                Set rCell = Nothing
                Set rCell = ws.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2)
                If Not rCell Is Nothing Then
                    ws.Range(rCell, ws.[XFD1]).EntireColumn.Clear
                End If
                Set rng = ws.UsedRange
            End If
            On Error GoTo 0
            If Not rng Is Nothing Then
                For Each Cell In rng
                    If Not Cell.Style.BuiltIn Then
                        With Cell
                            .Font.Bold = True
                            .Font.Color = vbBlue
                            .Interior.Color = vbGreen
                        End With
                    End If
                Next Cell
                Set rng = Nothing
                Set rCell = Nothing
            End If
        End If
    Next ws

    Set wb = Nothing

End Sub