I'm currently working on a VBA program that copies and pastes charts from multiple Excel sheets into either a newly generated PowerPoint or an existing one. However, I'm running into problems with the file paths entered by the user through a UserForm textbox.

The program fails to locate the files using the file paths provided through the textbox, even though it has no issues when the file paths are directly added to the code. "Run-time error 1004 Sorry we couldn't find (file path) . Is it possible it was moved, renamed or deleted?"

Additionally, I'm having trouble implementing a loop to iterate through an array of strings containing all the file paths. The program is able to run when I specify a single array element: ex. Set wb = Workbooks.Open(filePaths(0)), but gives a run time error when I try to iterate through the entire array, ex. Set wb = Workbooks.Open(filePaths(i)).

I would greatly appreciate any help in resolving these issues. I've included my code below:

Private Sub submit_Click()
    ' Make a new PowerPoint
    If generate.Value = True Then
        Dim filePaths() As Variant
        filePaths() = Array(xlFilePathInput.Text)
        ChartsToPpt filePaths()
   
    ' Existing PowerPoint
    ElseIf transfer.Value = True Then
        ' Check if a file path is provided
        If Len(filePathInput.Text) > 0 Then
            ChartsToPptExisting filePaths()
        Else
            MsgBox "Error: Please enter a file path"
    End If
    Else
        MsgBox "Error: Please check an option"
    End If
    
    Unload Me
End Sub

Public Sub ChartsToPpt(ByRef filePaths As Variant)
    Dim sht As Object
    Dim cht As Excel.ChartObject
    Dim appPpt As Object
    Dim prs As Object
    Dim wb As Object ' Workbook object
   
    
    Set appPpt = CreateObject("PowerPoint.Application")
    appPpt.Visible = True
    
    ' Open the custom template
    Set prs = appPpt.Presentations.Open("C:\Users\template.potx")

    prs.Slides.AddSlide 1, prs.Designs(1).slideMaster.CustomLayouts(1)
    
    ' Chart Transfer for each file
   ' For Each filePath In filePaths
       ' If Len(filePath) > 0 Then
       
    Dim i As Integer
    
    For i = LBound(filePaths) To UBound(filePaths)
    Set wb = Workbooks.Open(filePaths(i))
            
            For Each sht In wb.Sheets
                If sht.Visible = xlSheetVisible Then
                    Select Case LCase(TypeName(sht))
                        Case "worksheet"
                            For Each cht In sht.ChartObjects
                                cht.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
                                DoEvents
                                PasteChartImage prs, 200, 75, 450, 400 ' Left, Top, Width, Height
                            Next
                        Case "chart"
                            sht.ChartArea.Copy
                            DoEvents
                            PasteChartImage prs, 200, 75, 450, 400 ' Left, Top, Width, Height
                    End Select
                End If
            Next
      
            wb.Close False ' Close the workbook without saving changes
            Set wb = Nothing
    Next i
       ' End If
   ' Next
    
    Set appPpt = Nothing
    Set prs = Nothing
    Set slideMaster = Nothing
    Set titleShape = Nothing
    Set titleLayout = Nothing
End Sub


Public Sub ChartsToPptExisting(ByRef filePaths() As Variant)
    Dim sht As Object
    Dim cht As Object
    Dim appPpt As Object
    Dim prs As Object

    Set appPpt = CreateObject("PowerPoint.Application")
    appPpt.Visible = True

    'file path of the existing PowerPoint presentation
    Set prs = appPpt.Presentations.Open(pptFilePathInput.Text)

    

    ' Chart Transfer
    Set wb = Workbooks.Open(filePaths(0))
            
            For Each sht In wb.Sheets
                If sht.Visible = xlSheetVisible Then
                    Select Case LCase(TypeName(sht))
                        Case "worksheet"
                            For Each cht In sht.ChartObjects
                                cht.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
                                DoEvents
                                PasteChartImage prs, 200, 75, 450, 400 ' Left, Top, Width, Height
                            Next
                        Case "chart"
                            sht.ChartArea.Copy
                            DoEvents
                            PasteChartImage prs, 200, 75, 450, 400 ' Left, Top, Width, Height
                    End Select
                End If
            Next
            
            wb.Close False ' Close the workbook without saving changes
            Set wb = Nothing

    Set appPpt = Nothing
    Set prs = Nothing
    Set slideMaster = Nothing
    Set titleShape = Nothing
    Set titleLayout = Nothing
End Sub

Private Sub PasteChartImage(ByVal TargetPresentation As Object, ByVal LeftPos As Double, ByVal TopPos As Double, ByVal Width As Double, ByVal Height As Double)
    Dim sld As Object

    Set sld = TargetPresentation.Slides.AddSlide(TargetPresentation.Slides.Count + 1, TargetPresentation.Designs(1).slideMaster.CustomLayouts(2))
    sld.Shapes.Paste
    With sld.Shapes(sld.Shapes.Count)
        .Left = LeftPos
        .Top = TopPos
        .Width = Width
        .Height = Height
    End With
End Sub

The code is meant to read in the userinputs of each file path, set them into an array, and then iterate through opening each excel worbook, copying each chart, and pasting into a powerpoint, then closing the excel workbook and continuing to the next filepath in the array.

The program is unable to locate the excel files when inputted through the user form even though it has no problem finding them when I manually enter the file paths when making the array.

The program is also unable to loop through all the array elements, returning a run time error of 91 that does not occur when I access each array element by their index.

0

There are 0 best solutions below