PDA

View Full Version : All pivot charts export at a time to folder doesn't work in excel 2016



merciful
04-07-2017, 11:35 AM
Hi,

Below vba code is working perfectly in excel 2010, but not working in excel 2016. Actually i need export multiple pivot charts to folder. in red colour mentioned having the issues in excel 2016.


Sub Savetopic()
Dim i As Long
Dim j As Long
Dim shp As Shape
Dim cht As ChartObject
Dim StrPath As String
Dim shtnam As String
Dim A, B As String

j = 0
For i = 1 To Sheets.Count
If Sheets(i).Name = "Email" Then
j = i
End If
Next i

If j = 0 Or j = Sheets.Count Then Exit Sub

Application.DisplayAlerts = False
For i = Sheets.Count To j + 1 Step -1
StrPath = ActiveWorkbook.Path & Application.PathSeparator
Sheets(i).Select
shtnam = ActiveSheet.Name
ActiveSheet.Shapes.SelectAll
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Temp1"
ActiveSheet.Pictures.Paste.Select

With ActiveSheet
Set shp = .Shapes("Picture 1")
shp.Copy
shp.CopyPicture xlScreen, xlPicture
'// Depending on what's in the pic, you may need to add a few points to
'// hgt/wid
A = shp.Width
B = shp.Height
If shp.Width > 766 Then
shp.Width = 766
'shp.Height = 600
End If
Set cht = .ChartObjects.Add(0, 0, shp.Width, shp.Height)
cht.Chart.Paste
cht.Chart.Export StrPath & shtnam & ".jpg"
cht.Delete
Sheets("Temp1").Delete
End With

Set shp = Nothing
Set cht = Nothing
Next i

End Sub