I'm writing a macro that copies charts from xSheet1
and pastes them into xSheet2
as pictures. I'd like to give the pictures the xlMoveAndSize property, but I can't find a good way to do it.
I've tried to do something like this:
For Each xPic In xSheet2.Pictures
xPic.Placement = xlMoveAndSize
Next
The only problem with this method is that my xSheet2
contains thousands of pictures and it takes ages to go through all of them. It's redundant to reset the xlMoveandSize
property on all of them except the 8 most recently pasted pictures, so if I could somehow reference only those pictures or assign them to picture objects when I paste them into the sheet, I could significantly reduce the time it takes to run the current design.
When the pictures are pasted into xSheet2
they are not necessarily assigned the names "Picture 1" through "Picture 8" (or "Picture n-8" through "Picture n"), so I don't believe I can call the pictures by name unless I can set what their name will be prior to pasting them. If I could 'paste' the pictures directly into a variable, that would be ideal, though I think there may be a fundamental issue with that idea.
The only other work-around I can think of would be to export the charts from xSheet1
as pictures and save them in a temporary cache on the users hard drive with something like: xChart1.Export Filename:="C:\CachePath\Chart1", Filtername:="PNG"
and import them into xSheet2
with something like xPic1=xlApp.xSheet2.Pictures.Insert("C:\CachePath\Chart1")
. I'd really like to avoid this if possible though.
This is how I'm currently moving the pictures:
Sub GetChartPics()
'Variables
Dim xSheet1 as Worksheet 'source
Dim xSheet2 as Worksheet 'destination
Dim xChart1 as ChartObject 'chart1 from source
Dim xChart2 as ChartObject 'chart2 from source
'...
Dim xChart8 as ChartObject 'chart8 from source
Dim xPic as Picture
'Set chart objects and worksheets
'I'll spare the details here. I don's see how they'd be relevant, anyway.
'Move Charts
Application.CutCopyMode = False
xChart1.Chart.CopyPicture
xSheet2.Paste Destination:=xSheet2.Range("A3")
Application.CutCopyMode = False
xChart2.Chart.CopyPicture
xSheet2.Paste Destination:=xSheet2.Range("B3")
'...
Application.CutCopyMode = False
xChart8.Chart.CopyPicture
xSheet2.Paste Destination:=xSheet2.Range("H3")
'AssignMoveAndSize Property to pics
For Each xPic in xSheet2.Pictures
xPic.Placement = xlMoveAndSize
Next
Thanks
I've discovered that the macro runs much faster if instead of For Each xPic in XSheet2.Pictures
I use For Each xShape in xSheet2.Shapes
. This has the same effect and, although faster, still takes a bit of time. To make the macro a bit more aesthetic, I just display a modeless userform that says "please wait..." while the macro runs in the background. This solution works acceptably well for my purpose.
This is an abbriviation of what the code looks like now:
Sub GetChartPics()
'Variables
Dim xSheet1 as Worksheet 'source
Dim xSheet2 as Worksheet 'destination
Dim xChart1 as ChartObject 'chart1 from source
Dim xChart2 as ChartObject 'chart2 from source
'...
Dim xChart8 as ChartObject 'chart8 from source
Dim xShp as Shape
'Show modeless userform
Load PleaseWait
PleaseWait.Show (0)
'Set chart objects and worksheets
'I'll spare the details here. I don's see how they'd be relevant, anyway.
'Move Charts
Application.CutCopyMode = False
xChart1.Chart.CopyPicture
xSheet2.Paste Destination:=xSheet2.Range("A3")
Application.CutCopyMode = False
xChart2.Chart.CopyPicture
xSheet2.Paste Destination:=xSheet2.Range("B3")
'...
Application.CutCopyMode = False
xChart8.Chart.CopyPicture
xSheet2.Paste Destination:=xSheet2.Range("H3")
'Assign MoveAndSize Property to Shapes
For Each xShp in xSheet2.Shapes
xShp.Placement = xlMoveAndSize
Next
'Close Userframe
Unload PleaseWait