将Excel表格复制为图片，并将每张图片排列在最后一张下面

我对代码做了一些修改；我发现，将每张表复制为图片比使用

PasteSpecial xl PasteAll/xlPasteAllUsingSourceTheme

复制和粘贴更能保持表格的原始格式。现在，所有的图片都是一张一张地贴在另一张的上面，我希望每张图片都在下面或者在旁边。这就是我到目前为止所做的：

For fileIdx = 1 To fileSlct.SelectedItems.Count         'Loops through each of the selected items so we can use the sheets in the book
    Set srcBook = Workbooks.Open((fileSlct.SelectedItems(fileIdx)), ReadOnly:=True)
    Set xlSheet = srcBook.ActiveSheet
    For Each xlSheet In srcBook.Sheets
    Set rng = xlSheet.UsedRange       '"Selects" the data to be copied
    xlSheet.Activate
    With xlBook.Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Resize(rng.Rows.Count, rng.Columns.Count)
        .UnMerge                                    'Sence there are a lot of merged cells, we need to unmerge
        rng.CopyPicture appearance:=xlScreen, Format:=xlPicture     'Copies the range as diffined above
        .PasteSpecial
    End With
    Next xlSheet
    srcBook.Close False
Next fileIdx

---

编辑添加：如果表格作为图片复制，我是否需要合并单元格的零件？

您可以使用类的

Top

属性来定位副本。

Sheet

类有一个

Shapes

集合，我们可以使用它来参考要定位的形状：

Dim ws As Worksheet

Set ws = xlBook.Sheets("Sheet2")

With ws.Range("A" & Rows.Count).End(xlUp).Resize(rng.Rows.Count, rng.Columns.Count)
   .UnMerge
   rng.CopyPicture appearance:=xlScreen, Format:=xlPicture
   .PasteSpecial
End With

If ws.Shapes.Count = 1 Then ' position at top
   ws.Shapes(1).Top = 0
Else
   ws.Shapes(ws.Shapes.Count).Top = ws.Shapes(ws.Shapes.Count - 1).Height + 5 ' or whatever gap you want
End If

---

您可以使用shape类的

Top

和

Left

属性来定位图像：我是VBA的新手，但不确定如何定位：/At

ws.shapes.（0）。Top=0

我遇到了一个运行时错误，有一大堆长数字，指定集合的索引超出了范围，该集合是1绑定的，不是0，即第一个形状的索引从1开始，第二个形状的索引从2开始，等等。根据经验法则，像图纸或形状这样的对象集合从1开始，像字符串数组这样的数据集合从0开始。我已经更新了帖子。查看“形状”集合：