1

I am not an expert in VBA by far so I was trying to get the answers from the posts here, however, I was not successful. I have checked here,here and in many other places but was not able to get the solution of the problem which is the following.

I would like to have the image pasted from a certain link in the adjacent or any other cell. The problem however is - it works for may websites, but it does not seem to work properly for amazon.

For example, this link:

https://images-eu.ssl-images-amazon.com/images/I/51GqMAG1MGL._SY300_QL70_ML3_.jpg

It works maybe once or twice, and then it stops for no apparent reason. And then it can grab the image again in say 2-3 hours? Mind you, the link is not dynamic.

In order for there not to raise any additional questions, I am trying to ease the job for our company by printing the image on the invoice for the warehouse use.

As such, I am grabbing (scraping) the link to the image in column I (there is a gap about 30 lines between the values) and then pasting it 3 cells to the left where the invoice is located.

The script I am using:

Sub URLPictureInsert()
    Dim IMG As Shape
    Dim xRg As Range
    Dim xCol As Long

    On Error Resume Next

    Application.ScreenUpdating = False
    Set rng = ActiveSheet.Range("I18:I2000")

    For Each cell In rng
        If cell <> "" Then
            filenam = cell
            ActiveSheet.Pictures.Insert(filenam).Select
           Set IMG = Selection.ShapeRange.Item(1)
        End If

        If IMG Is Nothing Then GoTo lab

        xCol = cell.Column - 2
        Set xRg = Cells(cell.row, xCol)

        With IMG
            .LockAspectRatio = msoTrue
            'If .Width > xRg.Width Then .Width = xRg.Width * 12 '/ 3
            'If .Height > xRg.Height Then .Height = xRg.Height * 12 '/ 3
            .Top = xRg.Top + (xRg.Height - .Height)
            '.Top = Range("E10").Top
            '.Left = Range("E10").Left
            .Left = xRg.Left + (xRg.Width - .Width)
            .Width = 150
            .Height = 150
        End With
lab:
        Set IMG = Nothing
        'Range("G15").Select
    Next

    Application.ScreenUpdating = True
End Sub

If any of you could be so kind to either modify this script or provide me with an alternative, I would sincerely appreciate it. If anything, running Office 365 64-bit.

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
Sergey Nizhnick
  • 11
  • 2
  • Please note that `On Error Resume Next` hides **all** error messages until `End Sub` but the errors still occur you just cannot see the messages. Remove this line to see your errors and fix them, otherwise your code cannot work properly (see [VBA Error Handling – A Complete Guide](https://excelmacromastery.com/vba-error-handling)). • Also don't use `GoTo` this is a very bad practice and you can easily change this into a normal `If … Then` like `If Not IMG Is Nothing Then` and replace `lab:` with `End If`. – Pᴇʜ Dec 12 '19 at 09:34
  • I have tried disabling it, but the only error I get is "Unable to get the Image property". – Sergey Nizhnick Dec 12 '19 at 09:37
  • Instead of inserting the picture directly from the internet `ActiveSheet.Pictures.Insert(filenam)` I recommend to download the file to a temporary folder first (Google to find a suitable method how to download files with VBA there are hundreds of tutorials). Then insert from temp folder `ActiveSheet.Pictures.Insert(temp_filenam)` and finally delete the temporary file (to tidy up). This way you have control over the download process and if something goes wrong it is in your control. This approach is much more reliable. – Pᴇʜ Dec 12 '19 at 09:46
  • I totally understand you :) It give the error in the line: `ActiveSheet.Pictures.Insert(filenam).Select` And in all honesty I really do not know why it sometimes comes with this error and sometimes it does not :( – Sergey Nizhnick Dec 12 '19 at 09:47
  • Try what I explained in my last comment. I've seen this kind of problems already a lot when using a link in `Pictures.Insert`. Download the file first. – Pᴇʜ Dec 12 '19 at 09:48
  • I'll give it a try. I can't find the correct link now, I've seen such solution already somewhere, tried it, but it did not work IIRC. – Sergey Nizhnick Dec 12 '19 at 09:52
  • *"it did not work"* is not usefull for us to help you. We need all the details and a good question. See [ask] and [mcve]. Give it a try again,and if it does not work. Ask a new question, include the code you have tried and tell which errors you get and in which line of code. That's the best way to get a good answer. – Pᴇʜ Dec 12 '19 at 09:55

0 Answers0