как получить гиперссылки списком в Екселе с картинок ? #788957

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

Минимум один способ есть, но он тебе не понравится.

Есть и второй способ, но он окажется сложным для тебя

Какие ты уже испробовала?

ты шо, я тупая, шо я могла придумать ? ничего .... ((

Используй магию фото, в личной карточке :)

а по   существу ?

никто  не  знает  ?

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

это  что  вы  только  что  сказали ?   )))) вот с  ссылками  есть  примеры  в  нете,  а  картинки вроде  как  к  ячейкам  не  привязаны, нипанятна  ((

Распаковываете zip и выковыриваете из *.rels

тут же нашел myOlApp = Новый COMОбъект ("excel.Application"); MyWo= myOlApp.Workbooks.Open(MyPath, , True); MySheet=MyWo.Worksheets(MyList); Для Каждого  MyPic Из MySheet.Pictures Цикл MyShape=MySheet.Shapes(MyPic.Name);     MyShape.CopyPicture; наверно в свойствах MyPic будет ссылка, хотя и не факт) информации много, особенно в гугле

Может, это поможет:

а можно как то более поэтапно  ? Откуда зип ? Запаковать, а потом распаковать ?

здесь ссылка MyShape.Hyperlink.Address

эту процедуру из в какую-то ячейку тулить ? в какую ? не могу определить, в какой ячейке картинка ((

Это код для 1Сv8

т.е. невозможно перебрать лист Ексель, не подключая 1С ?

Картинки не находятся ни в каких ячейках. Это коллекция листа. Путь к первой картинке такой : ActiveWorkbook.ActiveSheet.Shapes.Item.Hyperlink.Address

Возможно. Воспользуйтесь vbs.

Наберите в поисковике "vbs открыть файл excel"

+ Положение на листе задается так : ActiveWorkbook.ActiveSheet.Shapes.Item.TopLeftCell.Column ActiveWorkbook.ActiveSheet.Shapes.Item.TopLeftCell.Row

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

Ей нужно не снаружи. Ей нужно внутри листа. И VBS в этом случае нужно заменить на VBA.

мммм.... а для блондинки можно перевести ? что-то я вообще.... все сложнее и сложнее  ((((( ааааааа плакаю  (((

я думала, что ссылки картинок  вывести не очень сложно, типа как обычные  ссылки  (((

Для блондинки написано

Выводи, разрешаю.

+

"Обычные" ссылки вводятся руцями. Точно также можно ввести и прочитать гиперссылки установленные для картинок.

где этот ActiveWorkbook.ActiveSheet.Shapes.Item.TopLeftCell.Column  записать нужно ? в ячейку ?

да, это очень похоже. Вот я открываю вкладку Рзработчик в Екселе, а потом что ?

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

аааа просмотр кода! я  записала его с поддержкой макросов! и сохранила! а потом что ?

а теперь наверное нужно вызвать процедуру эту ? как ?

так их много, очень много

> не могу найти способ чтоб вывести список ссылок Куда вывести?

в список. В соседнюю с картинками ячейки например.

да я слабый прог. Так, помощник ....

скоко  вы  хотите денег ? блин, не пойму как вызвать процедуру

Я в vba не силен.

Alt+F11 откроется редактор макросов

да, и я  туда записала это. А теперь нужно вызвать на выполнение. Как ? Sub Save_Object_As_Picture     Dim avFiles, li As Long, oObj As Object, wsSh As Worksheet, wsTmpSh As Worksheet     Dim sImagesPath As String, sBookName As String, sName As String     Dim wbAct As Workbook     Dim IsForEachWbFolder As Boolean     avFiles = Application.GetOpenFilename("Excel Files(*.xls*),*.xls*", , "Выбрать файлы", , True)     If VarType(avFiles) = vbBoolean Then Exit Sub          IsForEachWbFolder = (MsgBox("Сохранять картинки каждой книги в отдельную папку?", vbQuestion + vbYesNo, ";) = vbYes)          If Not IsForEachWbFolder Then         sImagesPath = Environ("userprofile") & "desktopimages" '"         If Dir(sImagesPath, 16) = "" Then             MkDir sImagesPath         End If     End If     On Error Resume Next     Application.ScreenUpdating = False     Application.DisplayAlerts = False     Set wsTmpSh = ThisWorkbook.Sheets.Add     For li = LBound(avFiles) To UBound(avFiles)         Set wbAct = Workbooks.Open(avFiles(li), False)         'создаем папку для сохранения картинок         If IsForEachWbFolder Then             sImagesPath = wbAct.Path & "" & wbAct.Name & "_images"             If Dir(sImagesPath, 16) = "" Then                 MkDir sImagesPath             End If         End If         sBookName = wbAct.Name         For Each wsSh In Sheets             For Each oObj In wsSh.Shapes                 If oObj.Type = 13 Then                     '13 - картинки                     '1 - автофигуры                     '3 - диаграммы                     oObj.Copy                     sName = ActiveWorkbook.Name & "_" & wsSh.Name & "_" & oObj.Name                     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                 End If             Next oObj         Next wsSh         wbAct.Close 0     Next li     Set oObj = Nothing: Set wsSh = Nothing     wsTmpSh.Delete     Application.DisplayAlerts = True     Application.ScreenUpdating = True     MsgBox "Объекты сохранены", vbInformation, "; End Sub

я нажала Run. оно спросило меня ""Сохранять картинки каждой книги в отдельную папку?" и ничего дальше не произошло  (((

а если жму "нет" , то Еrror 76  ((

вообще-то, мне не нужно сохранять картинки. мне нужно список гиперссылок этих картинок  ((

процедура выполнилась. картинки записались в папку. но мне картинки  не нужны были ((

это Пять баллов! "ОЧЕНЬ жаль" что там не было функции к...ll Как можно запускать что то не зная какой будет результат?

Ветка о любви к халяве.