Попытка воспроизвести функцию IMAGE () из Google Таблиц в Excel

Question

Мне нужен быстрый и наглядный способ проверить, верны ли URL-адреса моих изображений и соответствуют ли они предоставленным данным. Мне нужна функция (например, Google Image ()) для быстрого предварительного просмотра изображения URL.

До сих пор я мог загрузить изображение с помощью моей собственной функции image (), но она помещает изображение как плавающий элемент. Есть ли способ заставить изображение внутри ячейки и расширить ячейку до высоты и ширины изображения 100x100? << Это позволяет мне заполнять и видеть результаты для нескольких строк данных. </p>

Вот мой код VBA:

Function Image(url As String)
    Dim pic As Picture
    Dim pcell As Range
        Set pcell = Application.Caller
    
        Set pic = ActiveSheet.Pictures.Insert(url)
        With pic
        .ShapeRange.LockAspectRatio = False
        .Left = pcell.Left
        .Top = pcell.Top
        .Width = pcell.Width
        .Height = pcell.RowHeight
        .Placement = xlMoveAndSize
        End With

    Exit Function
End Function

Я не очень хорошо знаком с VBA. Пожалуйста, объясните любое закодированное решение.

Answer 1

К сожалению, вы не можете добиться этого с помощью функции, используемой в формуле ячейки. Вы можете погуглить «что можно и чего нельзя делать с udf в excel vba». Одна из вещей, которую вы не можете сделать, - это изменить размер ячеек, если вызывается из Excel (то есть как формула в ячейке). Это сработает, если вы вызовете функцию из vba. В коде вы можете определить, как функция вызывается через Application.Caller, которая будет возвращать ссылку на ячейку, если вызывается из Excel.

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

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim cl As Range
    Set cl = Target
    On Error Resume Next
    If cl.Value <> "" Then
        Dim pic As Picture
        'Me.Pictures.Delete
        Set pic = Me.Pictures.Insert(cl.Value)
        If Err.Number <> 0 Then Exit Sub
        On Error GoTo 0
        If Not pic Is Nothing Then
            Cancel = True
            With pic
                .Left = cl.Left
                .Top = cl.Top
                cl.EntireColumn.ColumnWidth = 20
                .Width = cl.Width
                cl.EntireRow.RowHeight = .Height
            End With
        End If
    End If
End Sub

Обратите внимание, что вам не нужно устанавливать высоту изображения, поскольку она будет автоматически изменена, поскольку соотношение сторон для изображений заблокировано (по умолчанию). Также обратите внимание, что .ColumnWidth и .RowHeight не обязательно имеют один и тот же блок (их нет на моем компьютере), поэтому вы должны быть осторожны с этим. Может быть, кто-то сможет пролить больше света на эту проблему .

Еще одна вещь, которую вам нужно иметь в виду, если вы выберете go с опцией функции, заключается в том, что каждый раз, когда функция пересчитывается, вы получите новое изображение, добавленное поверх того, что уже было добавлено, поэтому вам нужно найти способ избежать этого.