Как назначить формулу анонимной фигуре? - PullRequest
0 голосов
/ 09 января 2019

Я пытаюсь присвоить формулу объекту, но каждый раз получаю ошибки. Суть в том, что каждый раз, когда я копирую изображение, мне нужно назначить формулу для вновь опубликованного элемента. На самом деле, у меня нет конкретного имени формы, поэтому я могу его использовать. Есть предложения?

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

1 Ответ

0 голосов
/ 09 января 2019

Вы не можете определить форму, используя ссылку на диапазон напрямую. Что делает этот пример, так это просматривает все фигуры на указанном листе ... и находит первую фигуру, где верхний левый угол фигуры находится в указанной ячейке (т. Е. 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...