Import pictures from URL Issues

Question

I have used a VBA script to import pictures into a cell based on a URL. It works well, but the image disappears if I delete or alter the link. With Kutools image import, is the image inserted into the cell as a permanent image?

I intend to email the Excel spreadsheet to someone who won't have access to my local hard drive. This means the images will disappear.

Here is the VBA I am currently using: I also have trouble copying and pasting into Word using this VBA. I can only copy and paste about ten images into Word, which takes time if you have a lot of pictures.

Sub AddImageToRight()
Dim OrigSelection As Range
Set OrigSelection = Selection
For Each cell In Selection
ThisPath = cell.Value
HoldRight = cell.Offset(0, 1).Value
cell.Offset(0, 1).Clear
Err.Clear
On Error Resume Next
cell.Offset(0, 1).Select
Selection.InsertPictureInCell (ThisPath)
If Err.Number <> 0 Then Selection.Value = HoldRight
Next cell
OrigSelection.Select
End Sub

~~~~~~~~~~~~~~~~~~~~~~

This one replaced the URL with an image, but I still had an issue copying and pasting it into Word. Plus I lost my URL in the cell which was replaced with a image.

Sub ReplacePathWithImage()
Dim OrigSelection As Range
Set OrigSelection = Selection
For Each cell In Selection
ThisPath = cell.Value
cell.Clear
Err.Clear
On Error Resume Next
cell.Select
Selection.InsertPictureInCell (ThisPath)
If Err.Number <> 0 Then cell.Value = ThisPath
Next cell
OrigSelection.Select
End Sub

~~~~~~~~~~~~~~~~~~~~~

Here is what I used previously, but the image wouldn't insert itself in the cell. I manually had to click on each image to insert it into the cell I wanted. It was close, but it was a pain. This is an issue if you have over 200 images floating in Excel that need to be matched to a cell to the left.

Sub ImportPicturesFromColumn()
Dim ws As Worksheet
Dim picturePath As String
Dim pic As Picture
Dim picWidth As Double
Dim picHeight As Double
Dim maxWidth As Double
Dim maxHeight As Double
Dim aspectRatio As Double
Dim cell As Range
Dim startCell As Range
Dim targetCell As Range

' Set the worksheet to "CA-ExcelExport"
Set ws = ThisWorkbook.Sheets("CA-ExcelExport")

' Set the maximum width and height for the picture
maxWidth = 420 ' Set to your desired max width
maxHeight = 420 ' Set to your desired max height

' Set the starting cell for the list of picture paths
Set startCell = ws.Range("K4") ' Start reading paths from cell K4

' Loop through each cell in the column until an empty cell is found
For Each cell In ws.Range(startCell, ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp))
picturePath = cell.Value

' Stop processing if a blank cell is encountered
If picturePath = "" Then
Exit For
End If

' Add the picture to the worksheet
Set pic = ws.Pictures.Insert(picturePath)

' Get the original dimensions of the picture
picWidth = pic.Width
picHeight = pic.Height

' Calculate the aspect ratio
aspectRatio = picWidth / picHeight

' Adjust the picture size to maintain aspect ratio
If picWidth > maxWidth Or picHeight > maxHeight Then
If (maxWidth / maxHeight) > aspectRatio Then
picHeight = maxHeight
picWidth = maxHeight * aspectRatio
Else
picWidth = maxWidth
picHeight = maxWidth / aspectRatio
End If
End If

' Set the new dimensions
pic.Width = picWidth
pic.Height = picHeight

' Determine the target cell for the picture
Set targetCell = ws.Cells(cell.Row, "Q") ' Place picture in column H, same row as file path

' Position the picture within the target cell
pic.Top = targetCell.Top
pic.Left = targetCell.Left

' Optionally, resize the cell to fit the picture
targetCell.RowHeight = Application.Max(targetCell.RowHeight, pic.Height)
targetCell.ColumnWidth = Application.Max(targetCell.ColumnWidth, pic.Width / 5.7) ' Adjust column width
Next cell
End Sub

Імпортуйте зображення з URL Issues