Встраивание иконки контекстного объекта с использованием Excel VBA

Question

Я немного неопытен в кодировании VBA и мне нужна помощь для вставки объекта в электронную таблицу Excel на основе ссылки на ячейку.

Что мне нужно сделать, это вытащить PDF-файл как значок объектаосновываясь на содержимом другой ячейки, наложите его на определенную ячейку, а затем переместите строку вниз, чтобы повторять бесконечно, пока не появится пустая ячейка.
Одна из проблем заключается в том, что номер элемента в столбце A может не иметь соответствующего файла, который соответствуетон находится в моей файловой директории, поэтому мне нужно, чтобы код выполнялся независимо от ошибки в поиске PDF.Вот пример макета моего листа. Пример таблицы

Вот небольшой кусочек кода, который я уже собрал вместе, однако я не уверен, что его можно использовать даже удаленно.

Dim varItem
Sub Insert_PDF_Object()

    Range("A2").Select    

    Do Until IsEmpty(ActiveCell)
        varItem= ActiveCell.Offset(0, 0)
        ActiveCell.Offset(0, 0).RowHeight = 80
        Get_Object
        ActiveCell.Offset(1, 0).Select
    Loop

    Range("A3").Select

End Sub

Sub Get_Object()

        Worksheets("Sheet1").OLEObjects.Add Filename:="c:\Test\"& 
            Range("A2").Value & ".pdf", Link:=False, DisplayAsIcon:=True, 
            Left:=40, Top:=40, Width:=100, Height:=100
End Sub

Любая помощьлюбой может обеспечить это было бы здорово!

Answer 1

Попробуйте это.

Обратите внимание, что если вы хотите использовать DisplayAsIcon:=True, вам необходимо указать путь к файлу значка и индекс.

https://msdn.microsoft.com/en-us/vba/excel-vba/articles/oleobjects-add-method-excel

Sub Insert_PDF_Object()
    Dim c As Range, fName
    Set c = ActiveSheet.Range("A2")

    Do While Len(c.Value) > 0

        fName = "c:\_Stuff\Test\" & c.Value & ".pdf"

        If Dir(fName, vbNormal) <> "" Then
            c.RowHeight = 80
            c.Worksheet.OLEObjects.Add Filename:=fName, Link:=False, _
                DisplayAsIcon:=True, _
                Left:=c.Offset(0, 1).Left, _
                Top:=c.Offset(0, 1).Top, _
                Width:=80, Height:=80
        End If

        Set c = c.Offset(1, 0)
    Loop

End Sub