Recorrer libro, buscar gráficos y tablas, exportar por un botón automáticamente a una plantilla PowerPoint
Necesito crear una macro que me permita recorrer el libro para buscar en las hojas las tablas y gráficos que tenga, e ir exportando a una plantilla antes creada de PowerPoint, tengo la siguiente macro, pero solo la hice para obtener una tabla, no se como llamar el objeto de gráfico.
Sub Generar_Presentacion()
' Generar variables
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape
Dim tableranges() As Excel.Range
' Activar en la pestaña Herramientas/Referencias "Microsoft Scripting Runtime"
Dim pptPath, pptName, lastpptPath As String
Dim FSO As Scripting.FileSystemObject
Dim check As Boolean
Dim i As Integer
Set FSO = New FileSystemObject
On Error Resume Next
' Abre la plantilla predeterminada
pptName = "Plantilla"
pptPath = ThisWorkbook.Path & "\" & pptName & ".pptx"
lastpptPath = FSO.GetParentFolderName(pptPath)
On Error Resume Next
Set pptApp = GetObject("", "PowerPoint.Application")
Err.Clear
If pptApp Is Nothing Then Set pptApp = CreateObject(class:="PowerPoint.Appliaction")
pptApp.Visible = True
pptApp.Activate
On Error GoTo OpenPresentation
Set pptPres = pptApp.Presentations(pptName)
GoTo ContinueHere
OpenPresentation:
Set pptPres = pptApp.Presentations.Open(pptPath)
ContinueHere:
ReDim tableranges(1)
' Copiar rango de tabla para exportar. Ir a la pestaña donde esta la tabla y seleccionar su rango
Set tableranges(1) = ActiveWorkbook.Worksheets("DatosSeguiInteg").Range("A1:D11")
tableranges(1).Copy
' Pegar tabla en hoja seleccionada de PowerPoint
With pptPres.Slides(3).Shapes.PasteSpecial(ppPasteDefault)
.Name = ("Tabla" & 5)
.Top = 110
.Left = 30
End With
nom = ActiveWorkbook.Name
pto = InStr(nom, ".")
nomarch = Left(nom, pto - 1)
ruta = ThisWorkbook.Path
pptPres.SaveAs (ruta & "\" & nomarch)
'Cerrar el archivo y emitir mensajes.
MsgBox ("La presentación se generó con éxito"), vbInformation, "AVISO"
Sheets("Menú").Select
End Sub
