Inserir imagem vba

[guilherme.utuari]

Boa tarde,

 

tenho um código VBA que inseri uma imagem em uma determinada área pré-estabelecida, aí que está minha dúvida, gostaria de alterar este código para que eu pudesse inserir a imagem na célula e que as dimensões já se enquadrassem nesta célula.

 

Se alguém puder me ajudar, agradeço.

 

Segue o código VBA abaixo e a planilha em anexo.

 

Private Sub CommandButton1_Click()
    Dim profile As String
    On Error GoTo 0
    Dim fd As FileDialog
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Picture Files", "*.bmp;*.jpg;*.gif;*.png"
        .ButtonName = "Select"
        .AllowMultiSelect = False
        .Title = "Choose Photo"
        .InitialView = msoFileDialogViewDetails
        .Show
    End With
    ActiveSheet.Range("E3").Select
    
    With ActiveSheet.Pictures.Insert(fd.SelectedItems(1))
        
        .Left = ActiveSheet.Range("photograph").Left + 2
        .Top = ActiveSheet.Range("photograph").Top + 2
        .Placement = 1
        .PrintObject = True
        profile = .Name
    End With
    ActiveSheet.Pictures(profile).Select
    With Selection.ShapeRange
        .LockAspectRatio = msoFalse
        .Width = 123
        .Height = 134
    End With
    
End Sub
 

LEM_Browse_Photo.xlsx

[Basole]

Pelo que entêndi voce quer que a imagem se ajustasse (Larg/ Alt.), a uma determinada celula:.

 

Na  alteração do codigo, macro vai inserir na celula F15.

Altere de acordo c/ sua necessidade: 

 

Private Sub CommandButton1_Click()
    Dim profile As String
    On Error GoTo 0
    Dim fd As FileDialog
    Dim myCel As Range
    Set myCel = ActiveSheet.Range("F15") ' AQUI: Altere a cel. desejada
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Picture Files", "*.bmp;*.jpg;*.gif;*.png"
        .ButtonName = "Select"
        .AllowMultiSelect = False
        .Title = "Choose Photo"
        .InitialView = msoFileDialogViewDetails
        .Show
    End With
    ActiveSheet.Range("E3").Select
    
    With ActiveSheet.Pictures.Insert(fd.SelectedItems(1))
        i = 17
        .Left = myCel.Left
        .Top = myCel.Top
        .Placement = 1
        .PrintObject = True
        profile = .Name
    End With
    ActiveSheet.Pictures(profile).Select
    With Selection.ShapeRange
        .LockAspectRatio = msoFalse
        .Width = myCel.Width
        .Height = myCel.Height
    End With
    
End Sub

[guilherme.utuari]

@Basole é quase isso, mas eu gostaria que o vba identificasse qual célula eu estou selecionando e a imagem fosse inserida nesta célula, pois a célula que insiro a imagem é variável.

[Basole]

Guilherme, se tivesse incluido esta informação, já teria resolvido

 

Por favor, substitua esta linha no codigo: 

 Set myCel = ActiveSheet.Range("F15") ' AQUI: Altere a cel. desejada

Por esta: 

Set myCel = ActiveCell

abx.

[guilherme.utuari]

@Basole funciona perfeitamente, porém só um detalhe que estou em dúvida, toda vez em que acesso a planilha e tento adicionar uma imagem pela primeira vez, está primeira imagem é adicionada com formato real e o botão de adicionar a foto se deforma também, o que posso estar fazendo errado?

[Basole]

Pra mim aqui funcionou direitinho.

Realmente não sei te dizer sem ver sua plan.

Verifique se procedeu a alteração do cod corretamente.

Quanto ao botão voce pode substitui-lo por um atalho de teclado.

Altere no nome da sub: Private Sub CommandButton1_Click() -> para Public Sub CommandButton1_Click() volte a planilha aperte ALT + F8 e selecione a respectiva macro e na janela em opções escolha uma tecla,  de preferência a letra "q" ou "w" 

 

abx. 

[guilherme.utuari]

Fiz as alterações porém não adiantou, não sei também o que estou fazendo de errado, outro problema que notei também, é que após adicionar a imagem a barra de rolagem volta até a primeira linha, o que as vezes dificulta se estou colando seguidas imagens em linhas muito distantes da primeira, estou anexando a planilha, no caso as abas que insiro as imagens são as "failures" e "correct", por favor, se puder ver o que fiz de errado, agradeço!

Report 2015 - ESN.xlsx

[Basole]

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

 

abx.

Report 2015 - ESN.zip

[guilherme.utuari]

@Basole Obrigado! deu certo!

[oswaldoagro]

AQUI DEU TUDO CERTO O CÓDIGO! ÓTIMO! PORÉM TERIA COMO INSERIR IMAGEM EM UMA CÉLULA MESCLADA?

 

POIS EU MESCLEI A CÉLULA E QUERIA COLOCAR A IMAGEM DENTRO DELA!

 

 

OBRIGADO!

[Juliana.souza]

@Basole tem alguma forma para que a imagem seja inserida no campo de imagem que criei com o comando do activeX, ao invés de ser em uma célula?

[Basole]

@Juliana.souza tem sim. Segue exemplo em anexo.

 

Inserir_Imagem_ActiveX.zip

[Nadjala]

@Basole, Tudo bem? É possível salvar uma imagem, que foi carregada em um formulário, e quando apertar no botão salvar, essa imagem é salva em um controle de imagem activex dentro de uma das abas da planilha? grata!!

[Basole]

@Nadjala sim é possivel. Segue exemplo:

 

Private Sub CommandButton1_Click()
 'Altere o caminho e nome da imagem de acordo com seus dados
 Const suaImagem As String = "C:\Temp\" & "NomedaSuaImagemdoUserform" & ".jpg"

     SavePicture Me.Image1.Picture, suaImagem
     'Altere de acordo c/ seus dados?
     ThisWorkbook.Worksheets(1).Image1.Picture = LoadPicture(suaImagem)
     
  VBA.Kill suaImagem
  
End Sub

 

[Nadjala]

@Basole Muito obrigada por responder! Mas não rodou aqui, não consigo identificar meu erro.

Eu adaptei ao meu arquivo, porém apresenta o seguinte erro de compilação: Uso inválido da palavra-chave Me

 

Os dados carregados no formulário são carregados numa aba da planilha, e no userform eu coloquei um controle de imagem que carrega a imagem no formulário para visualização, o botão salvar tem a função de salvar todos os dados do formulário na aba da planilha1, porém, apenas os textbox e combobox carregam na planilha1, as imagens não carregam na planilha1.

 

Meu objetivo é fazer com que essa imagem também seja carregada na planilha1, dentro de um controle de imagem do activex (ImageFoto1), esse controle fica dentro da célula C85.

 

Eu criei um módulo com esse código, e no comandbutton que está no formulário eu coloquei:

 

Run "nova_imagem"

 

Segue  a adaptação que fiz:

 

Private Sub nova_imagem()

 

Planilha1.Activate

 

 'Altere o caminho e nome da imagem de acordo com seus dados

 Const suaImagem As String = "C:\Temp\" & "Image" & ".jpg"

     SavePicture Me.Image1.Picture, suaImagem

     'Altere de acordo c/ seus dados?

     ThisWorkbook.Worksheets(1).ImageFoto1.Picture = LoadPicture(suaImagem)
     
  VBA.Kill suaImagem
  
End Sub

[Basole]

@Nadjala a sua pergunta inicial, eu fui alem e apresentei um exemplo genérico.

Mas como você são conseguiu adaptar, sugiro que anexe o seu arquivo ou um exemplo bem próximo, para que possamos encontrar o erro e atender a sua demanda

 

* O Fórum não aceita anexos com extensão: " *.xlsm ". Compacte (zipe) seu arquivo, antes de anexar. 

 

 

  

[Nadjala]

@Basole Bom dia, segue em anexo o arquivo. Grata!

 

Formulario Planejamento de Manutenção.rar

[Basole]

@Nadjala precisa referenciar o local onde esta o image activeX pois a rotina esta em um modulo, fora do userform

E como são 8 imagens usei o For, para inserir dinamicamente as imagens nos activeX que estão na planilha

Private Sub nova_imagem()
Dim i            As Long
Dim suaImagem(8) As String

With ThisWorkbook
 .Activate

        With .Worksheets("MANUTENÇÃO")
        
        .Activate
         
         For i = 1 To 8
         
           ' *Altere o caminho e nome da imagem de acordo com seus dados
            suaImagem(i) = "C:\Temp\" & "ImageFoto" & i & ".jpg"
                        
                SavePicture UserForm2.Controls("Image" & i).Picture, suaImagem(i)
           
             .OLEObjects("ImageFoto" & i).Object.Picture = LoadPicture(suaImagem(i))
          
              VBA.Kill suaImagem(i)
                  
        Next
        
        End With
End With

End Sub

* Seria bom acrescentar uma forma de validacao, para que o usuario insira todas as imagens no userform, caso contrario, ocorrerá erros, na hora que for inserir as imagens na planilha.

[Nadjala]

@Basole É possível deixar um caminho genérico? Pois ele será usado em outros computadores.

Está dando erro nessa linha:

 

SavePicture UserForm2.Controls("Image" & i).Picture, suaImagem(i)

 

[Basole]

suaImagem(i) = Thisworkbook.path & "\" & "ImageFoto" & i & ".jpg"

@Nadjala qual foi o erro ? Se foi relacionado ao caminho/diretório tens que colocar um endereço válido na sua máquina, como comentei no código exemplo 

 

Para todos usuários pode armazenar, temporariamente na mesma pasta da pasta_de_trabalho. Exemplo acima

 

 

 

 

[Nadjala]

@Basole o erro foi:

adicionado 5 minutos depois

@Basole, não consegui entender, pois o caminho é genérico, a imagem pode estar em qualquer pasta.

[Basole]

17 horas atrás, Basole disse:

suaImagem(i) = Thisworkbook.path & "\" & "ImageFoto" & i & ".jpg"

 

Sim pode salvar em qualquer pasta pois e um arquivo temporario. Tem o comando kill que deleta, apos inserir a imagem na planilha. Use este exemplo acima que funcionará para qualquer usuário e PC. 

[Nadjala]

@Basole Funcionou!! Obrigada!

[Nadjala]

@Basole, Bom dia,

 

Como inserir uma restrição para que, ao clicar em salvar, apareça uma mensagem dizendo que deve anexar uma imagem no formulário?

 

Segue o codigo que carrega a imagem do userform no controle activex presente na planilha, obrigada:

 

Private Sub nova_imagem1()
Dim suaImagem1 As String

With ThisWorkbook
 .Activate

        With .Worksheets("MANUTENÇÃO")
        
        .Activate
        
          suaImagem1 = ThisWorkbook.Path & "\" & "ImageFoto1" & ".jpg"
                       
           SavePicture UserForm2.Image1.Picture, suaImagem1
                           
          .OLEObjects("ImageFoto1").Object.Picture = LoadPicture(suaImagem1)
          
              VBA.Kill suaImagem1
            
        End With
End With

End Sub

 

[Basole]

@Nadjala no formulario 2 e no botao salvar, voce tinha 8 imagens se nao me engano?  

 

Se for isso, coloque esta verificacao que checa se a imagem esta presentes nos controles de imagens activeX do userform2

 

Dim ftn As Integer

For ftn = 1 To 8
    If Me.Controls("Image" & ftn).Picture Is Nothing Then
       MsgBox "Insira a Foto " & ftn & " para continuar!", vbCritical, "Atencao"
    Exit Sub
    End If
Next

Ou se preferir que na mensagem apareca o nome ou a referencia da imagem, no evento userform Initialize "carrege" na propriedade .Tag das imagens activex a referencia, ex.: Image1.tag = "Horas de Funcionamento" e assim para os outros controles.

 

e utilize esta verificacao:

 

Dim ct As Control

For Each ct In Me.Controls
    If TypeName(ct) = "Image" Then
      If ct.Picture Is Nothing Then
        MsgBox "Insira a Foto " & ct.Tag & " para continuar!", vbCritical, "Atencao"
        Exit Sub
      End If
    End If
Next