Fix charts as embedded pictures

  • Thread starter Thread starter iperlovsky
  • Start date Start date
I

iperlovsky

I am currently using the following macro to fix all values in the workbook
and then delete certain tabs. I recently added 5 charts to the tab I want to
keep and was wondering if anyone knows how to fix the charts on that tab as
embedded picture files in the worksheet. Any suggestions on how to modify the
following routine, in particular the part that fixes all values to include
fixing the charts as embedded pictures, is appreciated.

Sub fixAll()
Application.DisplayAlerts = False
For i = 11 To Sheets.Count
With Sheets(i)
.UsedRange.Value = .UsedRange.Value
End With
Next i

Sheets([Transpose(Row(1:10))]).Delete

Application.DisplayAlerts = True
End Sub
 
Hi,

Small example

Sub ChartsToPictures()

Dim objCht As ChartObject
Dim shtTemp As Worksheet

For Each shtTemp In ActiveWorkbook.Worksheets
For Each objCht In shtTemp.ChartObjects
objCht.CopyPicture xlScreen, xlPicture
shtTemp.Paste
With shtTemp.Shapes(shtTemp.Shapes.Count)
.Left = objCht.Left
.Top = objCht.Top
End With
objCht.Delete
Next
Next

End Sub



Cheers
Andy
 
If the source of your five charts will remain on the undeleted sheets do you
really need to change them to pictures. If that's really the requirement
following should convert all embedded charts on worksheets 11 to .count.

Sub test()
Dim pic As Picture
Dim chtObj
Dim ws As Worksheet

For i = 11 To ActiveWorkbook.Worksheets.Count
Set ws = Worksheets(i)
For Each chtObj In ws.ChartObjects
With chtObj
' change arg's to suit
.Chart.CopyPicture Appearance:=xlScreen, _
Size:=xlScreen, _
Format:=xlPicture
Set pic = ws.Pictures.Paste
pic.Left = .Left
pic.Top = .Top
.Delete
End With
Next
ws.UsedRange.Value = ws.UsedRange.Value
Next

ReDim arr(1 To 10)
For i = 1 To 4
arr(i) = i
Next

Application.DisplayAlerts = False
Worksheets(arr).Delete
Application.DisplayAlerts = True

End Sub

Really the term "embedded picture" means as an OLE, that's possible but not
what the above does.

Regards,
Peter T
 
Thanks, that worked perfectly.

Andy Pope said:
Hi,

Small example

Sub ChartsToPictures()

Dim objCht As ChartObject
Dim shtTemp As Worksheet

For Each shtTemp In ActiveWorkbook.Worksheets
For Each objCht In shtTemp.ChartObjects
objCht.CopyPicture xlScreen, xlPicture
shtTemp.Paste
With shtTemp.Shapes(shtTemp.Shapes.Count)
.Left = objCht.Left
.Top = objCht.Top
End With
objCht.Delete
Next
Next

End Sub



Cheers
Andy
--

Andy Pope, Microsoft MVP - Excel
http://www.andypope.info
iperlovsky said:
I am currently using the following macro to fix all values in the workbook
and then delete certain tabs. I recently added 5 charts to the tab I want
to
keep and was wondering if anyone knows how to fix the charts on that tab
as
embedded picture files in the worksheet. Any suggestions on how to modify
the
following routine, in particular the part that fixes all values to include
fixing the charts as embedded pictures, is appreciated.

Sub fixAll()
Application.DisplayAlerts = False
For i = 11 To Sheets.Count
With Sheets(i)
.UsedRange.Value = .UsedRange.Value
End With
Next i

Sheets([Transpose(Row(1:10))]).Delete

Application.DisplayAlerts = True
End Sub
Click to expand...
Click to expand...
 
Back
Top