Importar Imagem para Excel

2024 - VBA & Macros

Post Recente por Alvaro 9 anos atrás

6 Posts

2 Usuários

0 Reactions

1,824 Visualizações

RSS

Alvaro

(@alvaro)

Posts: 78

Trusted Member

Topic starter

Pessoal, boa noite ou bom dia.
Pessoal estou com o seguinte problema.
Imaginem que as células de B1 a B50 tem as seguintes dimensões:
Altura: 150
Largura: 40

Em cada uma dessas colunas eu tenho que fazer o seguinte, importar uma foto (que esta normalmente em um pendrive ou as vezes até no próprio disco C), reduzi-las (Largura e Altura) ate que caibam na célula que tem as dimensões como dito acima, centraliza-la na célula (usando as "setinhas" do teclado) e depois compacta-la - como na imagem abaixo(para que o arquivo do excel não fique tão pesado, pois após concluído vou envia-lo por e-mail).

Eu queria o seguinte.
Eu clicaria na célula por exemplo B1 -> clicava no botão da macro -> abria a janelinha para importar o arquivo -> e após isso, através da Macro, faria tudo o que preciso acima.
Redimensionar a imagem para que ela caiba perfeitamente na célula B1 (Altura da célula: 150 e Largura da Célula: 40) -> Centralizar a imagem nesta célula -> e compactar a imagem como mostra na imagem em anexo.

Alguem consegue me ajudar?

Não sei se fui claro, quaisquer dúvidas estou a disposição.
Muitíssimo obrigado pessoal, ótima semana a vocês.

Postado : 21/09/2015 12:34 am

messiasmbm

(@messiasmbm)

Posts: 223

Estimable Member

Vê se atende sua necessidade...
Espero ter ajudado!

Postado : 21/09/2015 2:27 am

Alvaro

(@alvaro)

Posts: 78

Trusted Member

Topic starter

Boa noite messiasmbm, e muito obrigado por me ajudar.
Importou a imagem certinho, e colocou na célula que estava selecionada, porem deu pra ver que você especificou na macro as dimensões da imagem, e eu queria que isso fosse automático, que a imagem se ajustasse automaticamente a largura e altura da célula.
Qual o motivo disso:
Eu quero aproveitar a mesma macro em uma outra planilha, so que nesta planilha as células não tem altura e largura fixa.

Muito obrigado, ótima noite a vocês.

Postado : 21/09/2015 5:36 pm

messiasmbm

(@messiasmbm)

Posts: 223

Estimable Member

Vê se ficou melhor...
Eu redimensiono para que caiba na célula ativa...

Postado : 22/09/2015 7:19 am

messiasmbm

(@messiasmbm)

Posts: 223

Estimable Member

Esta é a macro que faz tudo neste arquivo que postei por ultimo!

Sub PROCURA()
 Dim Photo As Variant
    Dim Gauche, Sommet, Largeur, Hauteur As Single
 
    Photo = Application.GetOpenFilename("Images JPEG (*.jpg), *.jpg")
    Gauche = ActiveCell.Left
    Sommet = ActiveCell.Top
    Largeur = ActiveCell.Width
    Hauteur = ActiveCell.Height
 
    If Photo <> False Then
        Sheets("Plan1").Shapes.AddPicture Photo, True, True, Gauche, Sommet, Largeur, Hauteur
    End If



        
    
End Sub

Postado : 22/09/2015 7:26 am