Inserir imagem vba

[Nadjala]

@Basole Muito obrigada!! Deu certo!

[essapatricia]

Em 02/03/2015 às 14:00, Basole disse:

Guilherme,  mudei o codigo para o modulo 1  e agora as duas sheets usam o mesmo codigo. 

 

abx.

Report 2015 - ESN.zip

@Basole será que poderia me ajudar?

Esse seu código resolve quase todo o meu problema, só não queria que as imagens ficassem vinculadas ao local de origem, pra poder usar a planilha em qualquer computador.

Li em um tópico que bastaria usar Shape.Addpicture ao invés do Pictures.Insert

Como ficaria essa alteração no código da planilha que você subiu? (muuuito obrigada)

[TiagoJM]

Bom dia.

Faço muitos relatórios com fotos e cada um deles preciso anexar várias fotos, geralmente acima de 36 fotos.

Estou tentando vários códigos VBA, clicar em um botão, selecionar as fotos que quero anexar no corpo do relatório, e elas serem inseridas em espaços pré definidos com tamanho ajustado. São três fotos, uma ao lado da outra, outras três em baixo e assim por diante, separadas por páginas para poder realizar a impressão e ficar tudo configurado na página. Os códigos que encontrei são todos para formulários etc... Alguém pode me ajudar com esse código?

 

Vi um exemplo parecido com esse em um formulário dos bombeiros, onde clica em um botão, abre opção para selecionar o tipo de arquivo e a quantidade de fotos, selecionava 22 fotos e inseria no documento no local correto cada uma delas.

 

em anexo o campo onde preciso inserir as fotos.

MODELO DE RELATÓRIO COM FOTO.xlsx

[Midori]

@TiagoJM  As imagens serão inseridas nas células mescladas com o tamanho original.

 

Sub InserirFoto()
    Dim Linha   As Long
    Dim Coluna  As Long
    Dim Imagem  As Variant
    Dim I       As Integer
    
    Imagem = Application.GetOpenFilename("*.jpg,*.jpg", , , , True)
    
    Linha = 125
    Coluna = 3
    
    For I = 1 To UBound(Imagem)
        Cells(Linha, Coluna).Select
        ActiveSheet.Pictures.Insert Imagem(I)
        Coluna = Coluna + 36
        
        If I Mod 3 = 0 Then
            Coluna = 3
            Linha = Linha + 36
        End If
    Next I
End Sub

 

[TiagoJM]

@Midori não tem como fazer com que insira as imagens nos quadros especificados (conforme relatório em anexo) e com tamanho ajustado automaticamente?

[Midori]

@TiagoJM  É possível ajustar o tamanho da imagem. Com 150x120 fica bem próximo do tamanho do quadro.

 

Sub InserirFoto()
    Dim Linha   As Long
    Dim Coluna  As Long
    Dim Imagem  As Variant
    Dim I       As Integer
    Dim P       As Picture
    
    Imagem = Application.GetOpenFilename("*.jpg,*.jpg", , , , True)
    
    Linha = 125
    Coluna = 3
    
    For I = 1 To UBound(Imagem)
        Cells(Linha, Coluna).Select
        Set P = ActiveSheet.Pictures.Insert(Imagem(I))
        P.ShapeRange.LockAspectRatio = False
        P.Width = 150
        P.Height = 120
        Coluna = Coluna + 36
        
        If I Mod 3 = 0 Then
            Coluna = 3
            Linha = Linha + 36
        End If
    Next I
End Sub

 

[TiagoJM]

@Midori Deu certo, ficou muito bom. Obrigado.

[deejaywesley]

Boa Noite @Midori

 

Gostei deste codigo, mas me tire só uma duvida, teria como alterar essa parte dele...

Citação

P.Width = 150

P.Height = 120

para eu colocar por ex só o valor da altura P.Height = 120 e o outro ajustar proporcional a este valor, tipo:

digamos uma imagem de 600x600, ai na altura eu coloco 150, ai quando puxar a imagem ela diminuir o valor da largura de forma que não deformasse ela.... que ficaria 150x150, ou no caso de uma img de 1360X700 e eu colocasse 280 de altura quando puxar a imagem a largura seria 544...

 

deu pra entender minha duvida? kkkkkkkkkkkkkk

[Midori]

12 horas atrás, deejaywesley disse:

para eu colocar por ex só o valor da altura P.Height = 120 e o outro ajustar proporcional

Para ajustar assim tire estas duas linhas do código,

P.ShapeRange.LockAspectRatio = False
P.Width = 150

 

[deejaywesley]

@Midori  ficou top...

 

valeu

[Oreste Tatikawa]

Boa tarde

 

Estava lendo, porém não consegui

 

Tenho que inserir várias fotos, porém que fique uma em cada célula (uma embaixo da outra)

 

quando tentei com esses códigos, não funciou aqui

[Obadia]

@Basole Tem como fazer trazendo de uma URL? Tinha feito dessa forma mas não consegui.

 

Sub Carregar_fig()
  
    Sheets("Ligaçoes").range("b8").Value = LoadPictureUrl("https://foconoenem.com/wp-content/uploads/2019/10/Figuras-de-Linguagens-no-ENEM-saiba-diferenciar.png")
End Sub

[AfonsoMira]

@Obadia Boas, experimente assim:

Sub Carregar_fig()
'Data criação(mm/dd/aaaa): 2/9/2021
'Criado por: InforMira
'Contato: [email protected]

Dim myPicture As Picture
Dim rng As Range

Set rng = Range("B8")

    Set myPicture = Sheets("Ligaçoes").Pictures.Insert("https://foconoenem.com/wp-content/uploads/2019/10/Figuras-de-Linguagens-no-ENEM-saiba-diferenciar.png")

    With myPicture
        .ShapeRange.LockAspectRatio = msoFalse
        .Width = rng.Width
        .Height = rng.Height
        .Top = Rows(rng.Row).Top
        .Left = Columns(rng.Column).Left
    End With

 End Sub

 

[Obadia]

@InforMira Funcionou! Obrigado.