Macro to automatically search images and play in excel

Asked

Viewed 2,800 times

4

Good afternoon,

I have a spreadsheet, where I need to automatically include images. I wonder if there is any way to elaborate a macro, where you join the Reference and color (reference & color) and search in a certain folder the photo related to that code.

Ex:

inserir a descrição da imagem aqui

In the macro it is possible that when there is no photo in the folder named with (reference & color ex: 60557000156) it can jump and continue inserting photos for the next?

Existing macro: The macro that I use in other materials to search images is this below, but it needs to be repeated for each image I need, previously there were at most 20 images, but now for each page are at least 78 images and each excel tab has at most 6 page which results in approximately 468 images, so I look for a more summarized macro;

Sub Macros2()

    Call Imagem1
    Call Imagem2
    Call Imagem3
    '... 
    Call Imagem20

End Sub

Sub Imagem1()

    Range("B11").Select 'This is where picture will be inserted
    Dim picname As String
    picname = Range("A6") 'This is the picture name
    ActiveSheet.Pictures.Insert("\\storage\Img_Systextil\PROJETO LUNENDER\Fotos RPN\Inverno 2018\" & picname & ".JPG").Select  'Path to where pictures are stored
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' This resizes the picture
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    With Selection
        .Left = Range("B11").Left
        .Top = Range("B11").Top
        .ShapeRange.LockAspectRatio = msoFalse
        .ShapeRange.Height = 150#
        .ShapeRange.Width = 150#
        .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
excel vba macro

  • Yes. It is possible. As far as you have come with your attempt?

  • Good afternoon Diego. I could not develop anything for this spreadsheet in question, what I always did was to use an existing macro in another file and adapt to the new materials, because I am quite inexperienced in this subject. The macro I use needs to be repeated within the programming for each image I use (e.g. if I have 20 images I will have to repeat 20x) in this new file is another 500 images, so I can’t reuse it. I wonder if you can help me?

  • Put the code you have today, this macro there that needs to be repeated. Maybe from it we can help. But as the question is now, will probably be closed as too wide

  • 1

    posted on the question.

  • @danieltakeshi I think you’re right. I’ve reviewed it and it’s not quite a duplicate. I’ll withdraw the vote..

  • 1

    Possible duplicate of Add photo in excel spreadsheet from local folder

Show 1 more comment

1 answer

1

Code

Follow the example code to perform this. The explanation is as a comment in the code.

Dim ref As String, codImg As String, caminho As String, caminhoImg As String
Dim corRng As Range
Dim ws As Worksheet
Dim cor

'Declara a planilha
Set ws = ThisWorkbook.Sheets("Planilha1")
'Célula Referência
ref = ws.Range("C19")
'Intervalo de códigos das cores
Set corRng = ws.Range("C13:C15")
'Diretório com arquivos
caminho = "C:\Excel\testes"

'Loop em cada célula da Range de cores
For Each cor In corRng
    'Código do arquivo de Imagem
    codImg = ref & cor
    'Caminho inteiro do arquivo
    caminhoImg = caminho & "\" & codImg & ".jpg"
    'Insere Imagens
    With ws.Pictures.Insert(caminhoImg)
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Width = 75
            .Height = 100
        End With
        'Insere no 2, que é a coluna B e linha que está o código de cor
        .Left = ws.Cells(cor.Row, 2).Left
        .Top = ws.Cells(cor.Row, 2).Top
        .Placement = 1
        .PrintObject = True
    End With
Next cor

Browser other questions tagged excel vba macro

You are not signed in. Login or sign up in order to post.