Question

我正在尝试为对象分配公式，但是每次都会出错。要点是每次复制图像时，我都需要为新发布的项目指定一个公式。实际上，我没有特定的形状名称，因此可以使用。有什么建议吗？

  Dim sh As Shape
  Set sh = ActiveSheet.range("A" & Last_row ).Shape
  sh.DrawingObject.Formula = "=IMAGE" & Last_row

Answer 1

您不能直接使用范围参考来识别形状。该示例所做的是查看指定工作表中的所有形状...，并找到该形状的左上角在指定单元格中的第一个形状（例如，本示例中为C2）...返回该形状，以便可以为其指定公式（在此示例中为“ = B1”）。您应该能够接受并将其扩展为您要尝试执行的操作。

Option Explicit

Public Sub AssignShapeFormulaExample()
    Dim vShape As Shape
    Dim vRange As Range
    Dim vSheet As Worksheet

    ' Setup objects for the active sheet and an example cell (where a shape exists)
    Set vSheet = ActiveSheet
    Set vRange = vSheet.Range("C2")

    Set vShape = FirstShapeInCell(vSheet, vRange)

    If Not (vShape Is Nothing) Then
        vShape.DrawingObject.Formula = "=B1"
    End If

End Sub

Function FirstShapeInCell(vSheet As Worksheet, vRange As Range) As Shape
    Dim vShape As Shape
    Dim vShapeTopLeft As Range
    Dim vIntersect As Range

    ' Loop though all shapes in the designated sheet
    For Each vShape In vSheet.Shapes
        ' Setup a range that contains the top left corner of the shape
        With vShape
            Set vShapeTopLeft = vSheet.Cells(.TopLeftCell.Row, .TopLeftCell.Column)
        End With
        'See whether the shape in the range specified as an input parameter
        Set vIntersect = Application.Intersect(vRange, vShapeTopLeft)
        If Not (vIntersect Is Nothing) Then
            Set FirstShapeInCell = vShape
            Exit Function
        End If
    Next
End Function

如何将公式分配给匿名形状？

1 个答案: