Macro to automatically fetch images and play in excel

Question

Macro to automatically fetch images and play in excel

Navigation

#1 by (0 votes)

4

Good afternoon,

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

Ex:

Inthemacroitispossiblethatwhenyoudonothaveaphotointhefoldernamedwith(reference&colorex:60557000156)youcanskipitandcontinueinsertingphotosintothenextones?

Macroalreadyexists:ThemacroIuseinothermaterialstosearchforimagesisthisbelow,howeveritneedstoberepeatedforeachimageIneed,previouslytherewereamaximumof20images,howevernowforeachpageareatleast78imagesandeachexceltabhasamaximumof6pageswhichresultsinapproximately468images,soI'mlookingforamoresummarizedmacro;

SubMacros2()CallImagem1CallImagem2CallImagem3'...CallImagem20EndSubSubImagem1()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

macro imagem excel vba

asked by anonymous 10.04.2018 / 19:48

1 answer

Christofides Algorithm - TSP, Problem in transforming AGM into a graph with all vertices of even degree Monthly shift schedule

score 0 · Answer 1

Code

Follow the sample code to accomplish 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