Это моя модифицированная версия ответа, которую поделился с tomelin5. Он работает в Excel 2016 и, вероятно, (намного) в более ранних версиях.
В моем случае я создал приложение Microsoft PowerApps для сбора и хранения подписей с помощью ручки ввода.
В стороне: Если вы читаете это, потому что пытаетесь создать PowerApp: волшебным соусом для сохранения содержимого ваших элементов управления в электронную таблицу является функция Patch
.
Это работает так, что перьевой элемент управления сохраняет изображения в виде файлов PNG в каталоге и сохраняет относительные адреса к файлам PNG в виде URL-адресов в ячейках электронной таблицы: URL, например .\MyAppName_images\x829ca33re2d6114588e59ca45829d21.png
Я хотел отобразить эти подписи в этой электронной таблице Excel, чтобы их можно было отсортировать, используя другие данные, введенные через приложение. Решение tomelin5 работало так хорошо, как основа для моего решения, и я решил, что должен поделиться своим ремиксом.
Мое решение сохраняет URL-адреса в столбце "A" (1) и помещает сами изображения в столбец "I" (9). Он также регулирует высоту строк в соответствии с шириной столбца 9-го столбца, хотя вы, вероятно, захотите изменить / устранить это поведение.
Все URL-адреса обрабатываются, начиная с A2, и простираются до последней заполненной ячейки в столбце A. Обратите внимание, что мое решение не обрабатывает никаких исключений, и вам понадобится это в случае, если изображения были недоступны.
Sub Button1_Click()
' https://msdn.microsoft.com/en-us/library/office/aa221353(v=office.11).aspx
' http://www.excelhowto.com/macros/loop-range-cells/
' https://www.excelcampus.com/vba/find-last-row-column-cell/
' https://superuser.com/questions/52760/embed-pictures-from-web-by-url-in-excel-spreadsheet-or-oo-calc#
Dim Pic As Picture
Dim SrcRange As Range
Dim LastRowA As Long
LastRowA = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Set SrcRange = ActiveSheet.Range(Cells(2, 1), Cells(LastRowA, 1))
SrcRange.Rows().RowHeight = ActiveSheet.Columns(9).Width
For Each Cell In SrcRange.Cells
With Cell
Set Pic = .Parent.Pictures.Insert(.Value)
With .Offset(, 8)
Pic.Top = .Top
Pic.Left = .Left
Pic.Height = .Height
Pic.Width = .Width
Pic.Border.Color = vbRed
End With
End With
Next
End Sub