Reply to thread

Message: [QUOTE="K, post: 7410868"] 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 [/QUOTE]

Verification