Declarar tipo de variables en un código de macros de excel

Tengo un código que encontré en internet para exportar tablas de excel a powerpoint, el problema es que al correrlo en la declaración de variables me dice "Uso definido, tipo no definido", trate de declarar estas variables como tipo "variant", pero sigue marcadome error. Además me gustaría que el código no solo copie tablas para remplezarlas si no también gráficos. Anexo el código Gracias

Sub ExportaraPowerPointSeleccionado()

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
Dim windowdialog As Office.FileDialog
Dim pptPath, pptName, lastpptPath As String
Dim FSO As Scripting.FileSystemObject
Dim check As Boolean
Dim i As Integer
Set FSO = New FileSystemObject

'Asignar tablas a variables tableranges()
ReDim tableranges(1 To 2)
For i = 1 To 2
    Set tableranges(i) = ActiveWorkbook.Worksheets("Ejemplo"). _
    Range(Cells(7 + 7 * (i - 1), 2), Cells(12 + 7 * (i - 1), 7))
Next i

'Abrir ventana de dialogo para seleccionar archivo de PowerPoint
Set windowdialog = Application.FileDialog(msoFileDialogFilePicker)
    With windowdialog
        .AllowMultiSelect = False
        .Title = "Please Select a File"
        .Filters.Clear
        .Filters.Add "PPT", "*.ppt"
        .Filters.Add "All File", ""
        .ButtonName = "Select Report"
        .InitialFileName = ActiveWorkbook.Path
            If .Show = True Then
            pptPath = .SelectedItems(1)
            End If
         End With
pptName = FSO.GetFileName(pptPath)
lastpptPath = FSO.GetParentFolderName(pptPath)

'Comprobar que PowerPoint esta abierto
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

'Comprobar si el archivo seleccionado ya esta abierto
On Error GoTo OpenPresentation
Set pptPres = pptApp.Presentations(pptName)
GoTo ContinueHere
OpenPresentation:
Set pptPres = pptApp.Presentations.Open(pptPath)
ContinueHere:

'Buscar la tabla en el PowerPoint y sustituirla
i = 1
For Each pptSlide In pptPres.Slides
        pptSlide.Select
    For Each pptShape In pptSlide.Shapes
        If pptShape.Name = "Tabla" & i Then
            pptShape.Select
            pptShape.Delete
            tableranges(i).Copy
            pptSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile).Name = ("Tabla" & i)
            i = i + 1
        End If
    Next pptShape
Next pptSlide

'Recolocar las tablas y centrarlas en la diapositiva
For Each pptSlide In pptPres.Slides
    For Each pptShape In pptSlide.Shapes
        For i = 1 To pptSlide.Shapes.Count
            If pptShape.Name = "Tabla" & i Then
            pptShape.Left = ActiveWindow.Left + 200
            pptShape.Top = ActiveWindow.Top + 200
            End If
      Next i
    Next pptShape
Next pptSlide

End Sub

1 Respuesta

Respuesta
1

[Hola

No voy a detenerme en los detalles (hay un par de errores y en realidad tienes adaptar TODO a lo que tú tienes) pero necesariamente tienes que activar dos referencias en el editor de VBA:

- Microsoft Scripting Runtime

- Microsoft Power Point 15.0 Object Library (en donde el 15.0 puede ser otro número dependiendo de tu versión de Office)

Saludos]

Abraham Valencia

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas