Excel - вставка изображения из пути, используя ссылку на ячейку - PullRequest
0 голосов
/ 04 сентября 2018

Я использую приведенный ниже VBA для вставки изображений из локальной папки на основе пути в ячейке.

Код из этого предыдущего вопроса: Вставить картинку в макрос Excel, который принимает имя файла в качестве ссылки

' I set RowHeight in the excel to 125 and Picture Height to 100 so it fits nicely
' into the box that I want.
' That can be changed to suit your needs.
Sub InsertImageFullName()

    Application.ScreenUpdating = False


    Dim pic As String ' File path of a picture
    Dim cl As Range
    Dim i As Integer

    Set Rng = Range("A11:A16") ' Defining input range
    i = 1
    For Each cl In Rng

        pic = cl.Offset(0, 11)  ' Full path of the picture file:
                               ' Located in the same row, third column from A, i.e. column D
        If IsFile(pic) Then

            Set myPicture = ActiveSheet.Pictures.Insert(pic) ' Inserting picture from address in D column
                                                             ' into column A

            With myPicture ' Setting picture properties
                .ShapeRange.LockAspectRatio = msoTrue ' Keep aspect ratio
                .Height = 100 ' Set your own size
                .Top = Rows(cl.Row).Top
                .Left = Columns(cl.Column).Left
                .Placement = xlMoveAndSize
            End With
            CenterMe ActiveSheet.Shapes(i), cl
            i = i + 1
        End If

    Next    ' Looping to the Nth row, defined in:
            ' " Set Rng = Range("A13:A20") "

    Set myPicture = Nothing

    Application.ScreenUpdating = True

End Sub
Sub CenterMe(Shp As Shape, OverCells As Range)

    With OverCells
        Shp.Left = .Left + ((.Width - Shp.Width) / 2)
        Shp.Top = .Top + ((.Height - Shp.Height) / 2)
    End With
End Sub
Function IsFile(ByVal fName As String) As Boolean
'Returns TRUE if the provided name points to an existing file.
'Returns FALSE if not existing, or if it's a folder
    On Error Resume Next
    IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
End Function

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

Во-первых, я назначил это кнопке CMD, которая при нажатии вызывает макрос, но здесь странно то, что она перемещает кнопку CMD в первую ячейку, где должно отображаться изображение (т.е. первый результат).

Например: у меня есть путь в L11, который должен отобразить изображение в A11, а затем шаг вниз по листу. Что происходит, когда он перемещает командную кнопку, а затем переходит к A12 с изображением, A13 и т. Д. Странно!

Вторая проблема, которая, как мне кажется, связана, заключается в том, что она перемещает результаты изображения, скажем, с A11 на A12, затем с A12 на A13 и т. Д. Несмотря на сценарий, не указывающий вертикального смещения ... Этот сценарий в настоящий момент работает только на A11: 16 и в A16 это помещает два изображения. Одна ячейка сверху и правильная.

Итак, цикл работает и вытягивает правильное количество изображений, но из-за перемещения кнопки CMD туда, где находится первый результат, создается ложное смещение!

Есть идеи? Использовать что-то вместо CMD для вызова макроса?

Большое спасибо A

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...