将多个图像从一个工作簿复制到另一个工作簿作为单独的图像

In 2003 the code worked perfectly, we just updated to 2010 and its affecting our outgoing proposals.

在2003年，代码工作得很好，我们刚刚更新到2010年，它影响了我们即将发布的提案。

I've been looking on multiple sites and everything i have tried gives me all the pictures pasted into one grouped image OR gives me multiple boxes that say image cannot be viewed.

我一直在寻找多个网站，我尝试的一切都给了我所有的图片粘贴到一个分组图像或给我多个框，说无法查看图像。

The pictures will always be located in column L, but it can be one picture or 50 and even none. So i need to be able to select all images, copy and open another workbook and paste in a designated column with the same format and as separate images, not as a single image which is what I am getting right now. Any help would be greatly appreciated. Below is the latest code I have tried, still getting a "single grouped image" when pasting.

图片将始终位于列L中，但它可以是一张图片或50张甚至没有。因此，我需要能够选择所有图像，复制并打开另一个工作簿并粘贴到具有相同格式和单独图像的指定列中，而不是作为我现在正在获得的单个图像。任何帮助将不胜感激。下面是我尝试过的最新代码，在粘贴时仍会获得“单个分组图像”。

Windows(ourName2).Activate
Sheets("Sheet5").Select
On Error Resume Next
ActiveSheet.Pictures.Copy
Windows("Proposal.xls").Activate
Sheets("Sheet2").Select
ActiveSheet.PasteSpecial Range("L7")

Update, attempting to use this code raises error on the line Set wbSource = Workbooks("ourName2")

更新，尝试使用此代码会引发行上的错误设置wbSource = Workbooks（“ourName2”）

Dim wbSource As Workbook 
Dim wbDest As Workbook 
Dim shSource As Worksheet 
Dim shDest As Worksheet 
Dim shp As Shape 

Set wbSource = Workbooks("ourName2") 'modify as needed   
Set wbDest = Workbooks("MPlanner.xls") 'modify as needed 
Set shSource = wbSource.Sheets("Sheet5") 'modify as needed 
Set shDest = wbDest.Sheets("MAudit") 'modify as needed 

shSource.Pictures.Copy shDest.Range("L7").Paste

2 个解决方案

#1

This worked for me:

这对我有用：

Sub test()
    ActiveSheet.Pictures.Copy
    With Workbooks("temp.xls").Sheets("Sheet1")
        .Parent.Activate
        .Activate
        .Range("L7").Select
        .Paste
    End With
End Sub

#2

Echoing Tim, this worked for me, resulting in non-grouped pictures. There should not be any reason you need to Activate the respective sheets.

回应蒂姆，这对我有用，导致未分组的图片。您无需任何理由激活相应的工作表。

The problem seems to be that you were using PasteSpecial method instead of Paste. I have a 2003 box at home I could verify on, but on 2010 Excel, the PasteSpecial method pasts the multiple pictures as a single object, whereas Paste puts them each individually.

问题似乎是您使用的是PasteSpecial方法而不是Paste。我在家里有一个2003年的盒子我可以验证，但是在2010 Excel中，PasteSpecial方法将多个图片作为单个对象粘贴，而Paste会将它们各自单独放置。

Sub CopyAllPictures()
Dim wbSource As Workbook
Dim wbDest As Workbook
Dim shSource As Worksheet
Dim shDest As Worksheet
Dim shp As Shape

Set wbSource = Workbooks("Book12")          'modify as needed
Set wbDest = Workbooks("Book13")            'modify as needed

Set shSource = wbSource.Sheets("Sheet1")    'modify as needed
Set shDest = wbDest.Sheets("Sheet1")        'modify as needed

shSource.Pictures.Copy
shDest.Range("L7").Paste


End Sub

#1