在 VBA 中为 Excel 粘贴对象的 xlPlacement 枚举？

Question

我正在编写一个从 xSheet1 复制图表并将其作为图片粘贴到 xSheet2 的宏。我想给图片 xlMoveAndSize 属性，但我找不到好的方法。

我试过这样做：

For Each xPic In xSheet2.Pictures
    xPic.Placement = xlMoveAndSize
Next

此方法的唯一问题是我的 xSheet2 包含数千张图片，需要很长时间才能完成所有这些操作。除了最近粘贴的 8 张图片之外，在所有这些图片上重置 xlMoveandSize 属性是多余的，所以如果我能以某种方式仅引用这些图片或将它们分配给图片对象，当我将它们粘贴到 sheet，我可以显着减少运行当前设计所需的时间。

当图片被粘贴到 xSheet2 时，它们不一定被分配名称 "Picture 1" 到 "Picture 8"（或 "Picture n-8" 到 "Picture n"），所以我不相信我可以按名称调用图片，除非我可以在粘贴它们之前设置它们的名称。如果我可以 'paste' 将图片直接放入变量中，那将是理想的，尽管我认为该想法可能存在根本问题。

我能想到的唯一其他解决方法是将图表从 xSheet1 导出为图片并将它们保存在用户硬盘驱动器的临时缓存中，例如：xChart1.Export Filename:="C:\CachePath\Chart1", Filtername:="PNG"并使用 xPic1=xlApp.xSheet2.Pictures.Insert("C:\CachePath\Chart1") 之类的东西将它们导入 xSheet2。如果可能的话，我真的很想避免这种情况。

这就是我目前移动图片的方式：

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

谢谢

Answer 1

我发现如果我使用 For Each xShape in xSheet2.Shapes 而不是 For Each xPic in XSheet2.Pictures，宏运行速度会快得多。这具有相同的效果，虽然速度更快，但仍然需要一些时间。为了使宏更美观，我只显示一个无模式的用户窗体，在宏在后台运行时显示 "please wait..." 。这个解决方案对我的目的来说效果很好。

这是代码现在的缩写：

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

Answer 2

形状的名称可能与形状在 Shapes 集合中的索引无关。

这是我建议您使用的：

xChart8.Chart.CopyPicture
xSheet2.Paste Destination:=xSheet2.Range("H3")

With xSheet2
    .Shapes(.Shapes.Count).Placement = xlMoveAndSize
End With

我从未见过粘贴的形状不是工作表上的最后一个索引位置。

在 VBA 中为 Excel 粘贴对象的 xlPlacement 枚举？

xlPlacement Enumeration with pasted objects in VBA for Excel?

excel

vba

naming

copy-paste

variable-assignment