如何复制附加在工作表上的图像并将其粘贴到新的工作表中

我有用于从一个工作表中复制图像并将其粘贴到一个新的工作簿上的代码。 我的问题是'它只有在图像被附加在范围内时才起作用。我希望即使图像被附加到工作表上也能正常工作的代码'。

注意:input文件可能包含多个图像

我的代码是:

Set xlwbkinput = ActiveWorkbook Set xlwbkoutput = Excel.Workbooks.Add shtcountip = xlwbkinput.Sheets.Count shtcountop = xlwbkoutput.Sheets.Count If shtcountop < shtcountip Then For i = shtcountop To shtcountip + 1 xlwbkoutput.Worksheets.Add After:=xlwbkoutput.Worksheets(xlwbkoutput.Worksheets.Count) Next i End If For i = 1 To shtcountip 'it runs till the input workbook have the last sheet xlwbkinput.Worksheets(i).Activate xlwbkinput.Worksheets(i).Range("A1:AZ200").Copy 'here I'm copying input sheet xlwbkoutput.Worksheets(i).Activate xlwbkoutput.Worksheets(i).Paste 'here I'm pasting in my new worksheet Next i 

提前致谢!!!!

下面的For循环将遍历xlwbkinput.Worksheets(1) (索引为1的工作表xlwbkinput.Worksheets(1)所有形状。

然后检查当前Shape (图片)单元格位置是否大于1,这意味着它检查当前图片是否位于从第二行开始的任何单元格中 – 您可以轻松修改该条件。

 Dim myPics As Shape ' loop through all shapes in Worksheets(1) For Each myPics In xlwbkinput.Worksheets(1).Shapes If myPics.TopLeftCell.Row > 1 Then ' check if current shape's row is larger than 1 myPics.Copy '<-- copy the current picture End If Next myPics 

尝试以下方法:

 Option Explicit Public Sub tmpSO() Dim picIn As Picture Dim picOut As Picture Dim wksInput As Worksheet Dim wksOutput As Worksheet Dim cht As ChartObject Set wksInput = ThisWorkbook.Worksheets("Sheet1") Set wksOutput = ThisWorkbook.Worksheets("Sheet2") For Each picIn In wksInput.Pictures Set cht = wksInput.ChartObjects.Add(0, 0, picIn.Width, picIn.Height) cht.Chart.Parent.Border.LineStyle = 0 picIn.Copy cht.Chart.ChartArea.Select cht.Chart.Paste cht.Chart.Export Filename:=Environ("Temp") & "\someTempPicName.jpg", filtername:="JPG" Set picOut = wksOutput.Pictures.Insert(Environ("Temp") & "\tmpPic5022.jpg") picOut.Left = picIn.Left picOut.Top = picIn.Top cht.Delete Kill Environ("Temp") & "\someTempPicName.jpg" Next picIn End Sub 

该解决scheme使用worksheet.Pictures集合遍历表单中的所有图片。 最简单的方法是简单地.Copy.Paste这些图片从一张到另一张。 然而,这种方法会忽略每张图片在图纸上的位置。 假设你想让你的照片不是随机位于你的输出表上,上面的代码也会复制input表中的位置。