Search code examples
excelvbavariable-assignmentcopy-pastenaming

xlPlacement Enumeration with pasted objects in VBA for Excel?


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


Solution

  • 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