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

时间:2014-05-15 18:33:46

标签: image excel vba excel-vba

2003年,该代码运作良好,我们刚刚更新到2010年,影响了我们即将发布的提案。

我一直在寻找多个网站,我尝试过的所有内容都让我将所有图片粘贴到一个分组图像中,或者给了我多个框,说无法查看图像。

图片将始终位于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")

更新,尝试使用此代码会在行Set 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 个答案:

答案 0 :(得分:1)

这对我有用:

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

答案 1 :(得分:0)

回应蒂姆,这对我有用,导致未分组的图片。您应该没有任何理由Activate各自的表格。

问题似乎是您使用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