Редактирование макроса замены картинок на названия

[Kvant52]

Добрый день.

Нашел на этом сайте один макрос полезный:

Код: (vb)

Sub Save_Object_As_Picture()
    Dim li As Long, oObj As Shape, wsSh As Worksheet, wsTmpSh As Worksheet
    Dim sImagesPath As String, sName As String
    
    sImagesPath = ActiveWorkbook.Path & "\images\" '"
    If Dir(sImagesPath, 16) = "" Then
        MkDir sImagesPath
    End If
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wsSh = ActiveSheet
    Set wsTmpSh = ActiveWorkbook.Sheets.Add
    For Each oObj In wsSh.Shapes
        If oObj.Type = 13 Then
            li = li + 1
            oObj.Copy
            sName = "img" & li
            With wsTmpSh.ChartObjects.Add(0, 0, oObj.Width, oObj.Height).Chart
                .ChartArea.Border.LineStyle = 0
                .Parent.Select
                .Paste
                .Export Filename:=sImagesPath & sName & ".jpg", FilterName:="JPG"
                .Parent.Delete
            End With
            oObj.TopLeftCell.Value = sImagesPath & sName & ".jpg"
            oObj.Delete ' удаляем картинку с листа
        End If
    Next oObj
    Set oObj = Nothing: Set wsSh = Nothing
    wsTmpSh.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Картинки сохранены по пути: " & sImagesPath, vbInformation, "www.excel-vba.ru"
End Sub

Комментарий администратора

Коды оформляйте тегами VBCode. п.п. 4.25 Правил форума

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

[Дмитрий Щербаков(The_Prist)]

Код: (vb)

oObj.TopLeftCell.Value = sImagesPath & sName & ".jpg"

после этой строки запишите такую:

Код: (vb)

wsSh.Hyperlinks.Add Anchor:=oObj.TopLeftCell, Address:=sImagesPath & sName & ".jpg", TextToDisplay:=sImagesPath & sName & ".jpg"

И коды в сообщениях оформляйте тегами VBCode. п.п. 4.25 Правил форума

[Kvant52]

Комментарий администратора

убрал цитирование

Спасибо, про коды на будущее буду знать

[Дмитрий Щербаков(The_Prist)]

И про цитирование так же учтите - нет необходимости цитировать все сообщение - смотрится очень некрасиво и нечитабельно. Не цитируйте сообщения без необходимости, а если надо процитировать - выделите нужную часть фразы и нажмите ЦИТИРОВАТЬ. Тогда в цитату попадет только выделенная часть, а не все сообщение.
Спасибо.

[weblab]

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