VBA Add Pictures assigned to column range

Jasen79

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
VBA Code:
Sub InsertirPictures()
' Help from YKY & RoryA
' Personal Note: Below file path needs to be changed to where the IR phots are located!!!
'
    Const fPath = "C:\Users\576186\Pictures\"
    Dim a As Variant, cel As Range, picPath As String
      For Each a In Array("A38", "F38", "A54", "F54")
        Set cel = Range(a)
        picPath = fPath & cel.Value
               If Not Dir(picPath, vbDirectory) = vbNullString Then
            cel.Worksheet.Shapes.AddPicture Filename:=picPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
            Top:=cel.Offset(, 0).Top, Left:=cel.Offset(, 0).Left, Width:=209, Height:=209

        End If
    Next a
End Sub


ISSUE #FLOORROOMWALL / Floor / Ceiling / or GRID LINESOVERHEAD / OCCUPIED SPACE / UNDERFLOORDESCRIPTION /LOCATIONTYPE TAGISSUE #PHOTOPHOTO 2PHOTO 3
1Basement020-HallWEST WALLOCCUPIED SPACEremember to link some picsABANDONED Conductor1TK1.jpgTK2.jpgTK3.jpg
2Basement020-HallSOUTH WALLOCCUPIED SPACE0ABANDONED Conductor2TK4.jpgEUCOM.JPGPAE.JPG
3Basement19SOUTH WALLOCCUPIED SPACE0ABANDONED Conductor3000
4Basement19SOUTH WALLOCCUPIED SPACE0Building Material Left in Wall4000

Good Day, I am hoping one of you Brilliant coders can once again help or guide me to a solution.
In this workbook we consolidate all our reports on to one worksheet that we have gathered from multiple users. On the next worksheet, I filter the data needed at the time and export the findings in one format or another. PDF, Print, or Email.
There are pictures that are associated with date and are saved in folder. I need those pictures to be saved in the excel workbook. I am using a formula from another workbook some fine coders here helped me with. Now I need this code to look up an array of cells and over three columns. The data set may grow or shrink so I did not want a set cell but a flexible range.
Attached is the code I have.
And what the workbook looks like.
Can you please help?
Thanks in advance.
 

Jasen79

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
First thank you for taking the time.
Ran into a few issues.
When I ran the code the photos in column “I” were inserted. But nothing in columns J & K where not inserted. Please see errors below.
First Error Excel “An error occurred while importing this file. C:\Users\576186\Pictures\”
Second Error MVB: “Run-time error ‘1004’:
Application-defined or object-defined error
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Jasen79

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
VBA Code:
Sub main()

    Dim last_row As Long
    Dim cell As Range
    Dim col_num As Long
    Dim j As Long, i As Long

    last_row = Sheets(1).Range("I65536").End(xlUp).Row
    For j = 2 To last_row Step 1
    For i = 9 To 11 Step 1
        
                
            InsertirPictures Cells(j, i)

        Next i
    Next j

End Sub
Sub InsertirPictures(cel As Range)
    ' Help from YKY & RoryA
    ' Personal Note: Below file path needs to be changed to where the IR phots are located!!!
    '
    Const fPath = "C:\Users\576186\Pictures\"

    Dim picPath As String

    picPath = fPath & cel.Value
    If Not Dir(picPath, vbDirectory) = vbNullString Then
        cel.Worksheet.Shapes.AddPicture Filename:=picPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
        Top:=cel.Offset(, 0).Top, Left:=cel.Offset(, 0).Left, Width:=125, Height:=125

    End If

End Sub
OK, so after a little bit of trial and error, I found a Partial solution.
Reversing the Dim Cell and col_num at the top and flipping them in the code, all the pictures will now insert. However, I still get the same errors.
Also Solved the sizing issue.
Still getting:
First Error Excel “An error occurred while importing this file. C:\Users\576186\Pictures\”
Second Error MVB: “Run-time error ‘1004’:
Application-defined or object-defined error
 
Solution

yky

Well-known Member
Joined
Jun 7, 2011
Messages
1,873
Office Version
  1. 2010
Platform
  1. Windows
First thank you for taking the time.
Ran into a few issues.
When I ran the code the photos in column “I” were inserted. But nothing in columns J & K where not inserted. Please see errors below.
First Error Excel “An error occurred while importing this file. C:\Users\576186\Pictures\”
Second Error MVB: “Run-time error ‘1004’:
Application-defined or object-defined error
Looking at your data, I now see the problem. How do you get the zero in the cells? Do those cells contain a formula? I think the code is looking for 0.jpg which doesn't exist.

Change the main sub to the following. The new code will skip the cells that contain 0. Regarding the other error, do you know on which line the error occurs?

VBA Code:
Sub main()

    Dim last_row As Long
    Dim col_num As Long
    Dim cell As Range
    Dim i As Long, j As Long

    last_row = Sheets(1).Range("I65536").End(xlUp).Row
    
    Do While Sheets(1).Cells(last_row, 9) = 0
        last_row = last_row - 1
    Loop
    
    For i = 9 To 11 Step 1
        For j = 2 To last_row Step 1

            InsertirPictures Cells(j, i)

        Next j
    Next i
End Sub
 

Jasen79

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Looking at your data, I now see the problem. How do you get the zero in the cells? Do those cells contain a formula? I think the code is looking for 0.jpg which doesn't exist.

Change the main sub to the following. The new code will skip the cells that contain 0. Regarding the other error, do you know on which line the error occurs?

VBA Code:
Sub main()

    Dim last_row As Long
    Dim col_num As Long
    Dim cell As Range
    Dim i As Long, j As Long

    last_row = Sheets(1).Range("I65536").End(xlUp).Row
   
    Do While Sheets(1).Cells(last_row, 9) = 0
        last_row = last_row - 1
    Loop
   
    For i = 9 To 11 Step 1
        For j = 2 To last_row Step 1

            InsertirPictures Cells(j, i)

        Next j
    Next i
End Sub
Same error codes with the new code and only column I pictures where inserted. I took the when line of code you added to the last version. All pictures where inserted. Both ways I get the same error code even though it is doing what I need it to do.

When I run the debug this Is highlighted:
cel.Worksheet.Shapes.AddPicture Filename:=picPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Top:=cel.Offset(, 0).Top, Left:=cel.Offset(, 0).Left, Width:=125, Height:=125
 

yky

Well-known Member
Joined
Jun 7, 2011
Messages
1,873
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Same error codes with the new code and only column I pictures where inserted. I took the when line of code you added to the last version. All pictures where inserted. Both ways I get the same error code even though it is doing what I need it to do.

When I run the debug this Is highlighted:
cel.Worksheet.Shapes.AddPicture Filename:=picPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Top:=cel.Offset(, 0).Top, Left:=cel.Offset(, 0).Left, Width:=125, Height:=125
I just tested the code on my PC and didn't get any error message. I had I2:k4 with picture names and all those cells were filled with pictures. Not sure why you'd get errors. Sorry! Can't help on that one.
 
Last edited:

Jasen79

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
I just tested the code on my PC and didn't get any error message. I had I2:k4 with picture names and all those cells were filled with pictures. Not sure why you'd get errors. Sorry! Can't help on that one.
Thank you so much for your help.
Here is something odd. I ran it on Excel 2010 and would fine no issues or errors.
Only get the errors on mine, Excel 365.
And it wouldn't even run on the Mac version.
Thank you again.
Send me a direct message and I will send you some chocolate from Germany where I am at right now.
All the best and happy holiday.
 

yky

Well-known Member
Joined
Jun 7, 2011
Messages
1,873
Office Version
  1. 2010
Platform
  1. Windows
Thank you so much for your help.
Here is something odd. I ran it on Excel 2010 and would fine no issues or errors.
Only get the errors on mine, Excel 365.
And it wouldn't even run on the Mac version.
Thank you again.
Send me a direct message and I will send you some chocolate from Germany where I am at right now.
All the best and happy holiday.
I have heard comments that Mac version of Excel doesn't work well. The suggestion is to run Windows emulation on Mac and then run Windows' version of Excel on Mac. I can't test that idea because I don't use Mac. Since the code still works albeit the error message, maybe you just need to put up with the error message.

Thanks for the offer and happy holiday.
 

Watch MrExcel Video

Forum statistics

Threads
1,133,269
Messages
5,657,747
Members
418,411
Latest member
Excellency

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top