Question

我有用于从一个工作表复制图像并将其粘贴到新工作簿上的代码。我的问题是＆＃39;仅当图像附加在范围内时，它才有效。我希望代码能够工作即使图像附加在工作表上＆＃39;。

注意：输入文件可能包含多个图像

我的代码是：

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

先谢谢!!!!

Answer 1

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

然后它检查当前Shape（图片）单元格位置是否大于1，这意味着它检查当前图片是否位于从第2行开始的任何单元格中 - 您可以轻松修改该标准

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

Answer 2

尝试以下方法：

<select name="category_posts" id="category_posts">
    <option value="13">Long</option>
    <option value="14">Short</option>
    <option value="15">Evening</option>
    <option value="16">Hot</option>
    <option value="17">Sports</option>
</select>

此解决方案使用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集合迭代工作表上的所有图片。最简单的方法是将这些图片从一张到另一张简单地worksheet.Pictures和.Copy。然而，这种方法会忽略纸张上每张图片的位置。假设您想要的图片不是随机出现在您的输出表上，上面的代码也将复制输入表中的位置。

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

2 个答案: