Insert pictures and arrange

EileenJohn

Board Regular
Joined
Nov 23, 2016
Messages
53
Hi , can marco do this?
I want to insert 4 images side by side. 2 on top, 2 below. And arrange it properly in sheet. I have around 30 images. And save the workbook because after that I need to export the images. So basically,
1. Insert images( 4 images in one sheet)
2. Save workbook
Anyone can help me? Thanks in advance.
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Eileen,
Welcome to the Forum.
There are many threads on this Forum with examples of how to insert pictures onto a worksheet.
Assuming your filenames (complete path and filename in this format):

C:\Users\Pictures\yourfolder\filename.jpg

are listed in column C beginning in row 1 on Sheet1, the following macro will insert 4 pictures on each worksheet. Your pictures may have various formats and may not completely fit within the width of your printed worksheet, but you can adjust the sheet margins in the print preview dialog box and get the best fit. If you uncomment (remove the single quote at the beginning) the line of code in red font,
the pictures will be made to fit width wise as well as vertically. You may want to leave it commented out... that seemed to work better with the pictures I tested.
I set the right margin to '0.2' and left margin to '0.45' and the column widths to 48 for columns A and B. You can adjust those for yourself if needed.

As I said earlier, there are many examples of how to insert and adjust the picture size and spacing in your worksheet. You'll just have to do some searching and testing to see what works best for you.
Enter the code into a standard code module, then save as a macro enabled workbook. Try this on a copy of your workbook first so you don't lose anything important.
Perpa

Code:
Sub IMAGE()
    Dim Rng As Range
    Dim Cell As Range
    Dim Pic As Picture
    Dim s As Long
    Dim col, rw As Integer
    
    Application.ScreenUpdating = False
    For Each sh In Sheets("Sheet1").Shapes     'Deletes existing pictures from Sheet1
       sh.Delete
    Next sh
    LR = Cells(Rows.Count, "C").End(xlUp).Row
    For rw = 1 To LR Step 2      
        Rows(rw).RowHeight = 200     'Sets the vertical size of pictures, adust to suit
    Next rw
    
    For rw = 2 To LR Step 2      
        Rows(rw).RowHeight = 100     'Sets the vertical distance between sets of pictures, adust to suit
    Next rw
    
    Columns("A:A").ColumnWidth = 48    'Pictures will be in columns A & B
    Columns("B:B").ColumnWidth = 48
    Set Rng = Range("C1:C" & Range("C" & Rows.Count).End(xlUp).Row)     'URLs or complete path and filename will be in column C
    s = 1
   For Each Cell In Rng
        If Application.IsEven(s) Then     'Sets up the offset to insert picture in Column A or B
            col = 1
            rw = 1
        Else
            col = 2
            rw = 0
        End If
        With Cell
            On Error Resume Next
            Set Pic = .Parent.Pictures.Insert(.Value)
            If Err <> 0 Then
                Err.Clear
            Else
                With .Offset(-rw, -col)
                    Pic.Top = .Top
                    Pic.Left = .Left
                    Pic.Height = .Height
                    [COLOR=#ff0000]'Pic.Width = .Width[/COLOR]
                End With
            End If
            On Error GoTo 0
        End With
        s = s + 1
    Next Cell
    
    Application.ScreenUpdating = True
ActiveWorkbook.Save
End Sub
 
Upvote 0
Thanks perpa. Your code works like a charm. I still have this problem:
In column c1, I insert pathname
D:\pic\pic1.jpg
In column c2, I insert pathname
D:\pic\pic2.jpg
So, when I run the macro, the image is in vertical.
How can I make the pic2.jpg below pic1.jpg?
Which part of the code should I change?
 
Upvote 0

Forum statistics

Threads
1,213,563
Messages
6,114,329
Members
448,564
Latest member
ED38

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
Back
Top