Ir ao conteúdo
  • Cadastre-se

Inserir imagem vba


Ir à solução Resolvido por Basole,

Posts recomendados

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

Link para o post
Compartilhar em outros sites

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

Link para o post
Compartilhar em outros sites

@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?

Link para o post
Compartilhar em outros sites

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. 

Link para o post
Compartilhar em outros sites

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

Link para o post
Compartilhar em outros sites
  • 2 meses depois...
  • 4 anos depois...
  • 4 meses depois...

@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

 

  • Curtir 1
Link para o post
Compartilhar em outros sites

@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

Link para o post
Compartilhar em outros sites

@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. 

 

 

  

  • Curtir 1
Link para o post
Compartilhar em outros sites

@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.

  • Curtir 1
Link para o post
Compartilhar em outros sites
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

 

 

 

 

Link para o post
Compartilhar em outros sites
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. 

  • Curtir 1
Link para o post
Compartilhar em outros sites
  • 3 semanas depois...

@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

 

Link para o post
Compartilhar em outros sites

@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

 

Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Aprenda a ler resistores e capacitores

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!