Inserir fotos no excel

[fabio_ubta]

boa noite

gostaria de ajuda de vocês, como faço pra inserir imagens no excel com um tamanho pre definido,

ex. quero fazer uma planilha com quatro fotos, todas elas com o mesmo tamanho.

assim que eu inserir as fotos do arquivo, ela se enquadrar certo no mesmo tamanho nas celulas.

 

Desculpe se nao consegui me expressar muito bem, mai isso que preciso, ao inserir uma foto no arquivo, ela ja redimencionar para um determinado tamanho.

[Basole]

Bom dia veja se o exemplo ajuda:

A macro insere todas as imagens contidas na pasta indicada:

Sub InserirVariasImagens()
    Dim ImgPastL As String: ImgPastL = "C:\Users\Admin\pictures"    'AQUI *Altere o diretorio da sua pasta de imagens
    Dim ArqSel As String: ArqSel = Dir(ImgPastL & "\")
    Dim ImgX As Long, ImgY As Long, ImgSpac As Long, imgW As Long, imgH As Long
    Dim i As Long: i = 2
    Dim ct As String: ct = 0
    Celula = "A" & i
    ImgX = Range(Celula).Left
    ImgY = Range(Celula).Top
    ImgSpac = Range(Celula).Height * 17
    imgW = Range(Celula).Width * 30
    imgH = Range(Celula).Height * 13
    Do While ArqSel <> ""
        Celula = "A" & i
        ActiveSheet.Shapes.AddPicture ImgPastL & "\" & ArqSel, False, True, ImgX, ImgY, imgW, imgH
        ImgY = ImgY + ImgSpac
        ArqSel = Dir()
        i = i + 17
        ct = ct + 1
    Loop
    MsgBox ct & " Imagens foram inseridas !", 0, "Sucesso"
End Sub

[diego_janjao]

17 horas atrás, Basole disse:

Bom dia veja se o exemplo ajuda:

A macro insere todas as imagens contidas na pasta indicada:

Sub InserirVariasImagens()
    Dim ImgPastL As String: ImgPastL = "C:\Users\Admin\pictures"    'AQUI *Altere o diretorio da sua pasta de imagens
    Dim ArqSel As String: ArqSel = Dir(ImgPastL & "\")
    Dim ImgX As Long, ImgY As Long, ImgSpac As Long, imgW As Long, imgH As Long
    Dim i As Long: i = 2
    Dim ct As String: ct = 0
    Celula = "A" & i
    ImgX = Range(Celula).Left
    ImgY = Range(Celula).Top
    ImgSpac = Range(Celula).Height * 17
    imgW = Range(Celula).Width * 30
    imgH = Range(Celula).Height * 13
    Do While ArqSel <> ""
        Celula = "A" & i
        ActiveSheet.Shapes.AddPicture ImgPastL & "\" & ArqSel, False, True, ImgX, ImgY, imgW, imgH
        ImgY = ImgY + ImgSpac
        ArqSel = Dir()
        i = i + 17
        ct = ct + 1
    Loop
    MsgBox ct & " Imagens foram inseridas !", 0, "Sucesso"
End Sub

Grande @Basole ! Uma pergunta:

Caso eu queira definir uma imagem especifica da pasta, como por exemplo: IMG_01.JPG, sendo que a informação do nome da imagem viria de uma célula, como eu poderia fazer isso?

[Basole]

@diego_janjao Seria somente uma imagem? 

 

Supondo que a referida celula seja a E1:

 

Sub InserirVariasImagens_2()
    Const ImgPastL As String = "C:\Users\Admin\pictures"    'AQUI *Altere o diretorio da sua pasta de imagens
    Dim ArqSel As String, ImgX As Long, ImgY As Long, ImgSpac As Long, imgW As Long, _
        imgH As Long, i As Long, ct As Integer
        i = 2
    Celula = "A" & i
    ct = 0
    ArqSel = Dir(ImgPastL & "\" & ActiveSheet.[E1])    ' Altere o end da celula
    ImgX = Range(Celula).Left
    ImgY = Range(Celula).Top
    ImgSpac = Range(Celula).Height * 17
    imgW = Range(Celula).Width * 7
    imgH = Range(Celula).Height * 15
    Do While ArqSel <> ""
        ArqSel = Dir(ImgPastL & "\" & ActiveSheet.Range("E" & x))
        Celula = "A" & i
        ActiveSheet.Shapes.AddPicture ImgPastL & "\" & ArqSel, False, True, ImgX, ImgY, imgW, imgH
        ImgY = ImgY + ImgSpac
        ArqSel = Dir()
        i = i + 17
        ct = ct + 1
        x = 1
    Loop
    MsgBox ct & " Imagens foram inseridas !", 0, "Sucesso"
End Sub

 

[diego_janjao]

Tentei aqui e não deu certo.

17 horas atrás, Basole disse:

@diego_janjao Seria somente uma imagem? 

E sim, seria apenas uma imagem.

Cada registro que eu abro tem um número único e uma imagem correspondente. E por isso que eu queria que a macro buscasse na pasta indicada já a imagem do número em questão.