Question

我正在编写一个计算器。在工作表上，配置计算器选项（＆＃34; x＆＃34;和＆＃34; y＆＃34;）并在按下 showdata 按钮后，复制数据来自工作表概述并显示在工作表计算器中。

每个配置选项都有自己的图片。这些图片也列在概述表中。

对应于所选配置，相关图片应从工作表概览复制到工作表计算器并定位在单元格 D5 。如果表计算器中有另一张旧图片，则必须将其删除。这意味着按 showdata 按钮应该像相关数据和图片的实现按钮一样工作。

如何在上述情况下复制和定位图片？您可以在下面找到数据复制过程的工作代码段。

Public Sub showdata_click()

    Dim x As String
    Dim y As String

    x = Sheets("calculator").Range("B3").Value
    y = Sheets("calculator").Range("B4").Value

    '----------copying M5005 with C120 ------------------------------
    If x = "M5005" And y = "C120" Then
        Sheets("overview").Range("B17:B33").Copy
        Sheets("calculator").Range("B11.B27").PasteSpecial xlPasteValues
    End If

    '----------copying M5005 with C125 -------------------------------
    If x = "M5005" And y = "C125" Then
        Sheets("overview").Range("C17:C33").Copy
        Sheets("calculator").Range("B11.B27").PasteSpecial xlPasteValues
    End If

    '---------copying L3000 with C120 -----------------------------------
    If x = "L3000" And y = "C120" Then
        Sheets("overview").Range("B45:B61").Copy
        Sheets("calculator").Range("B11.B27").PasteSpecial xlPasteValues
    End If

    '----------copying L3000 with C250 ------------------------------------
    If x = "L3000" And y = "C250" Then
        Sheets("overview").Range("C45:C61").Copy
        Sheets("calculator").Range("B11.B27").PasteSpecial xlPasteValues
    End If

    '-----------copying L3000 with C180 ------------------------------------
    If x = "L3000" And y = "C180" Then
        Sheets("overview").Range("D45:D61").Copy
        Sheets("calculator").Range("B11.B27").PasteSpecial xlPasteValues
    End If

End Sub

Answer 1

为此，您需要知道图像在下面的单元格中的位置。

删除工作表中左上角与给定范围相交的所有图片：

Dim s As Shape, rng As Range
Set rng = Range("A1:B2")

    For Each s In ActiveSheet.Shapes
        If Intersect(rng, s.TopLeftCell) Is Nothing Then
            'do nothing
        Else
            s.Delete
        End If
    Next s

复制图片并将其与工作表中的单元格对齐：

Worksheets(1).Cells(1, 1).Copy Destination:=Worksheets(2).Cells(1, 1)

从第1页到第2页复制和定位图片

1 个答案: