Error

Option Explicit

Public Sub AbrirLibros()

    Dim img As Shape

    Dim fso As Object, fCarpeta As Object, tmpCarpeta As Object

    Dim Fichero As Object, tmpFichero As Object

    Dim strRutaInicial As String

    Dim chrt As ChartObject
    Dim nombreimg As String
    Dim Filename As String



    strRutaInicial = "D:\Check_List_Hold_Point"


    Set fso = CreateObject("Scripting.FileSystemObject")

    Set fCarpeta = fso.GetFolder(strRutaInicial)


    For Each tmpFichero In fCarpeta.Files

    If LCase(Mid(tmpFichero.Name, InStr(tmpFichero.Name, ".") + 1)) = "xlsx" Then
        Workbooks.Open tmpFichero.Path

        Application.ScreenUpdating = False
        For Each img In ActiveSheet.Shapes
        Charts.Add
        ActiveChart.ChartArea.Clear

        Set chrt = ActiveSheet.ChartObjects(1)
            nombreimg = img.Name
            With img
            chrt.Width = .Width
            chrt.Height = .Height
            .Copy
            End With
            chrt.Chart.Export Filename = "D:\Graficos\" & nombreimg & ".gif"
        chrt.Delete
        Next img
        Application.ScreenUpdating = True

        ActiveWorkbook.Close savechanges:=False
    End If

    Next tmpFichero


    Recursivo strRutaInicial

End Sub


Private Sub Recursivo(ByVal RutaInicial As String)

    Dim fso As Object, fCarpeta As Object, tmpCarpeta As Object

    Dim Fichero As Object, tmpFichero As Object

    Dim img As Shape
    Dim chrt As ChartObject
    Dim nombreimg As String
    Dim Filename As String


    Set fso = CreateObject("Scripting.FileSystemObject")

    Set fCarpeta = fso.GetFolder(RutaInicial)


    For Each tmpCarpeta In fCarpeta.SubFolders

        For Each tmpFichero In tmpCarpeta.Files

            If LCase(Mid(tmpFichero.Name, InStr(tmpFichero.Name, ".") + 1)) = "xlsx" Then
                Workbooks.Open tmpFichero.Path

                Application.ScreenUpdating = False
                For Each img In ActiveSheet.Shapes
                Charts.Add


                ' ActiveChart.Location Where:=xlLocationAsObject, Name:="Hoja1"
                Set chrt = ActiveSheet.ChartObjects(0)

                    nombreimg = img.Name
                    With img
                    chrt.Width = .Width
                    chrt.Height = .Height
                    .Copy
                    End With
                    ActiveChart.Paste

                    chrt.Chart.Export Filename = "D:\Graficos\" & nombreimg & ".gif"
                chrt.Delete
                Next img
                Application.ScreenUpdating = True


                ActiveWorkbook.Close savechanges:=False
            End If

        Next

        Recursivo tmpCarpeta.Path

    Next tmpCarpeta

End Sub