K
K
Hi all, i got macro (see on the bottom ) which supposed to copy chart from each workbook and paste into PowerPoint presentation. But when i run my macro i get error message saying (see below)
Run-time error '1004': The specified dimension is not valid for the current chart type
and it higlights this line (see below) in the macro
..Worksheets("Subdiv KPIs - New bus + Reten").ChartObjects("ch3").Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
Please can any friend help me on this.
***************MACRO*******************
Sub Create_Slideshow()
If ThisWorkbook.Worksheets("Control").TextBox1.Text = "" Then
MsgBox "Please select source folder path.", vbCritical, "Source path not selected!"
Else
Dim CB As Workbook
Dim FldrNm As String
Dim FSO As Object
Dim Fldr As Object
Dim Fl As Object
Dim wb As Workbook
Dim ppt As PowerPoint.Application
Application.ScreenUpdating = False
Set CB = ThisWorkbook
FldrNm = CB.Worksheets("Control").TextBox1.Text
Set FSO = CreateObject("Scripting.FilesystemObject")
Set Fldr = FSO.GetFolder(FldrNm)
For Each Fl In Fldr.Files
If Mid$(Fl.Name, InStrRev(Fl.Name, ".") + 1) = "xls" Then
Application.DisplayAlerts = False
Set wb = Workbooks.Open(Filename:=Fl.Path, UpdateLinks:=False)
Application.DisplayAlerts = True
With wb
Set ppt = New PowerPoint.Application
ppt.Visible = True
ppt.Presentations.Open Filename:=ThisWorkbook.Path & "\Sub Division template.pptx"
..Worksheets("Subdiv KPIs - New bus + Reten").ChartObjects("ch3").Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
ppt.ActivePresentation.Slides(7).Select
With ppt.ActivePresentation.Slides(7).Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
Application.CutCopyMode = False
..Width = 468.3383
..Height = 203.0116
..Left = 21.25
..Top = 98.07874
End With
..Worksheets("Subdiv KPIs - New bus + Reten").Range("A4:N4").CopyPicture xlScreen, xlPicture
ppt.ActivePresentation.Slides(7).Select
With ppt.ActivePresentation.Slides(7).Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
Application.CutCopyMode = False
..Width = 468.3383
..Height = 11.51926
..Left = 21.25
..Top = 310.5689
End With
ppt.ActivePresentation.SaveAs ThisWorkbook.Path & "\PP\" & Left(.Name, Len(.Name) - 4) & ".pptx", ppSaveAsDefault
ppt.ActivePresentation.Close
ppt.Quit
Set ppt = Nothing
..Close False
End With
Set wb = Nothing
End If
Next Fl
Set Fl = Nothing
Set Fldr = Nothing
Set FSO = Nothing
Set CB = Nothing
Application.ScreenUpdating = True
ThisWorkbook.Worksheets("Control").Activate
MsgBox "Its Done.", vbInformation, "Done!"
End If
End Sub
Run-time error '1004': The specified dimension is not valid for the current chart type
and it higlights this line (see below) in the macro
..Worksheets("Subdiv KPIs - New bus + Reten").ChartObjects("ch3").Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
Please can any friend help me on this.
***************MACRO*******************
Sub Create_Slideshow()
If ThisWorkbook.Worksheets("Control").TextBox1.Text = "" Then
MsgBox "Please select source folder path.", vbCritical, "Source path not selected!"
Else
Dim CB As Workbook
Dim FldrNm As String
Dim FSO As Object
Dim Fldr As Object
Dim Fl As Object
Dim wb As Workbook
Dim ppt As PowerPoint.Application
Application.ScreenUpdating = False
Set CB = ThisWorkbook
FldrNm = CB.Worksheets("Control").TextBox1.Text
Set FSO = CreateObject("Scripting.FilesystemObject")
Set Fldr = FSO.GetFolder(FldrNm)
For Each Fl In Fldr.Files
If Mid$(Fl.Name, InStrRev(Fl.Name, ".") + 1) = "xls" Then
Application.DisplayAlerts = False
Set wb = Workbooks.Open(Filename:=Fl.Path, UpdateLinks:=False)
Application.DisplayAlerts = True
With wb
Set ppt = New PowerPoint.Application
ppt.Visible = True
ppt.Presentations.Open Filename:=ThisWorkbook.Path & "\Sub Division template.pptx"
..Worksheets("Subdiv KPIs - New bus + Reten").ChartObjects("ch3").Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
ppt.ActivePresentation.Slides(7).Select
With ppt.ActivePresentation.Slides(7).Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
Application.CutCopyMode = False
..Width = 468.3383
..Height = 203.0116
..Left = 21.25
..Top = 98.07874
End With
..Worksheets("Subdiv KPIs - New bus + Reten").Range("A4:N4").CopyPicture xlScreen, xlPicture
ppt.ActivePresentation.Slides(7).Select
With ppt.ActivePresentation.Slides(7).Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
Application.CutCopyMode = False
..Width = 468.3383
..Height = 11.51926
..Left = 21.25
..Top = 310.5689
End With
ppt.ActivePresentation.SaveAs ThisWorkbook.Path & "\PP\" & Left(.Name, Len(.Name) - 4) & ".pptx", ppSaveAsDefault
ppt.ActivePresentation.Close
ppt.Quit
Set ppt = Nothing
..Close False
End With
Set wb = Nothing
End If
Next Fl
Set Fl = Nothing
Set Fldr = Nothing
Set FSO = Nothing
Set CB = Nothing
Application.ScreenUpdating = True
ThisWorkbook.Worksheets("Control").Activate
MsgBox "Its Done.", vbInformation, "Done!"
End If
End Sub