adding a loop to macro to insert pictures Solved/Closed

Question

Hello,
Could someone please help me in writing a loop in this macro in excel :
I have an excel sheet where it contains the name of the pictures in column B.  I have written a Macro to pick up the name of the picture in column B and insert the actual picture from directory into column A.
I need create a loop to do this depending on the number of pictures in the column B.  The number of rows varies from 10 to 1000.
The macro that I have written works perfect for the first row but does not go to the next row since I am not sure how to do it.

Thanks for your help in advance. 
Vida


Please see the macro that I’ve written:- 

Sub Picture()
 Range("A6").Select 'This is where picture will be inserted
     Dim picname As String
    picname = Range("B6") 'This is the picture name
    ActiveSheet.Pictures.Insert("C:\Users\vbayat\My Documents\vidabayat\re-market\" & picname & ".jpg").Select 'Path to where pictures are stored
     '''''''''''''''''''''''''''''''''''''''''''''''''''''''
     ' This resizes the picture
     '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    With Selection
         .Left = Range("A6").Left
         .Top = Range("A6").Top
        .ShapeRange.LockAspectRatio = msoFalse
        .ShapeRange.Height = 100#
        .ShapeRange.Width = 80#
        .ShapeRange.Rotation = 0#
    End With
     
    Range("A10").Select
    Application.ScreenUpdating = True

    Exit Sub
    
ErrNoPhoto:
     MsgBox "Unable to  Find Photo" 'Shows message box if picture not found
    Exit Sub
    Range("B20").Select
     
   End Sub

rizvisa1 · Accepted Answer

I have not tested your macro, but for looping you can try some thing like this

Assumptions
1. picture names are found in col B starting at B2
2. You want to paste each picture at different location
3. where to paste the picture identified in col B, is found in col C starting at C2


Sub Picture()
 Dim picname As String
 
 Dim pasteAt As Integer
 Dim lThisRow As Long
 
    lThisRow = 2
 
    Do While (Cells(lThisRow, 2) <> "")
    
        'Range("A6").Select 'This is where picture will be inserted
        pasteAt = Cells(lThisRow, 3)
        Cells(pasteAt, 1).Select 'This is where picture will be inserted
        
        'Dim picname As String
        'picname = Range("B6") 'This is the picture name
         picname = Cells(lThisRow, 2) 'This is the picture name
         
        ActiveSheet.Pictures.Insert("C:\Users\vbayat\My Documents\vidabayat\re-market\" & picname & ".jpg").Select 'Path to where pictures are stored
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' This resizes the picture
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        With Selection
            '.Left = Range("A6").Left
            '.Top = Range("A6").Top
            .Left = Cells(pasteAt, 1).Left
            .Top = Cells(pasteAt, 1).Top
            
            .ShapeRange.LockAspectRatio = msoFalse
            .ShapeRange.Height = 100#
            .ShapeRange.Width = 80#
            .ShapeRange.Rotation = 0#
        End With
        
        lThisRow = lThisRow + 1
    
    Loop
    
    Range("A10").Select
    Application.ScreenUpdating = True
    
    Exit Sub
    
ErrNoPhoto:
    MsgBox "Unable to Find Photo" 'Shows message box if picture not found
    Exit Sub
    Range("B20").Select

End Sub

Adding a loop to macro to insert pictures

1 response

Similar discussions

Subscribe To Our Newsletter!