Cómo Reducir el tamaño de un libro de Excel

Cómo Reducir el tamaño de un libro de Excel

   26 febrero       Luis Reyes

---

El trabajar todos los días un mismo archivo de excel puede traer ciertas complicaciones, como por ejemplo el tamaño ó peso del archivo que puede provocar fallas al cargar, cerrar o modificar celdas.

En la mayoria de los casos no se sabe que es lo está causando el problema, por eso muy complicado reducir el tamaño del libro.

Hace algunos años encontré una macro que me ayudó reducir el tamaño de los libros de excel, la cual se las comparto:

Sub Limpiar_rangos()
    Dim hj As Excel.Worksheet
    Dim copia$, ffin&, cfin&, TI&, TF&
    copia = crear_copia(ActiveWorkbook)
    MsgBox "Se ha creado una copia: " & vbLf & copia, vbInformation
    With ActiveWorkbook
        TI = VBA.FileLen(.FullName)
        For Each hj In .Worksheets
            ffin = 1
            cfin = 1
            With hj
                On Error Resume Next
                ffin = .UsedRange.Find(what:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                cfin = .UsedRange.Find(what:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
                On Error GoTo 0
                If .ProtectContents Then
                    If MsgBox("La hoja " & .Name & " se encuentra protegida." & vbLf & vbLf & _
                              "No se podrán limpiar los rangos de esta hoja a menos que se desproteja." _
                              & vbLf & vbLf & "¿Desea desprotegerla antes de continuar?", vbYesNo, _
                              "¡Hoja protegida!") = vbYes Then
                        If Desproteger(hj) Then
                            Limpiar hj, ffin, cfin
                        Else
                            MsgBox "No se ha desprotegido la hoja.", vbCritical, "¡Clave incorrecta!"
                        End If
                    End If
                Else
                    Limpiar hj, ffin, cfin
                End If
            End With
        Next hj
        .Save
        TF = VBA.FileLen(.FullName)
    End With
    MsgBox "Tamaño original: " & VBA.Format(TI, "#,##0") & " bytes." & vbLf & vbLf & _
           "Tamaño final: " & VBA.Format(TF, "#,##0") & " bytes." & vbLf & vbLf & _
           "El archivo se redujo en: " & VBA.Format(TI - TF, "#,##0") & " bytes" & _
           " (" & VBA.FormatPercent(Abs(TI / TF - 1), 2) & ")."
End Sub

Private Sub Limpiar(ByVal hj As Excel.Worksheet, ByVal ffin As Long, ByVal cfin As Long)
    With hj
        With .Range(.Cells(ffin + 1, 1), .Cells(.Rows.Count, 1)).EntireRow
            If .MergeCells = False Then .Clear
        End With
        With .Range(.Cells(1, cfin + 1), .Cells(1, .Columns.Count)).EntireColumn
            If .MergeCells = False Then .Clear
        End With
    End With
End Sub

Private Function crear_copia(ByVal Libro As Excel.Workbook) As String
        With Libro
            .Save
            crear_copia = .Path & Application.PathSeparator & VBA.Format(VBA.Now, "d-m-yy h-mm ") & .Name
            .SaveCopyAs crear_copia
        End With
End Function

Private Function Desproteger(ByVal hj As Excel.Worksheet) As Boolean
    On Error Resume Next
    hj.Unprotect
    Desproteger = Not VBA.CBool(Err.Number)
    On Error GoTo 0
End Function

Descarga el Archivo