Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Erro ao inserir ima...
 
Notifications
Clear all

Erro ao inserir imagem

 
2024 - VBA & Macros
Post Recente por Alvaro 8 anos atrás
6 Posts
2 Usuários
0 Reactions
2,012 Visualizações
RSS
 Alvaro
(@alvaro)
Posts: 78
Trusted Member
Topic starter
 

Pessoal, bom dia. Tudo bem com vocês?

Bom, tenho a seguinte macro

Dim Foto As Variant
    Dim Esquerda, Topo, Largura, Altura As Single

    Foto = Application.GetOpenFilename("Imagem (*.jpg;*.jpeg;*.gif;.*png), *.jpg;*.gif;*.jpeg;*.png,Todas (*.*), *.*", Empty, "Desenvolvido por.: Álvaro Horta e Suely Soares", Empty, Empty)
    Esquerda = ActiveCell.Left  + 1
    Topo = ActiveCell.Top  + 1
    Largura = ActiveCell.Width  - 1
    Altura = ActiveCell.Height  - 1

    If Foto <> False Then
        ActiveSheet.Shapes.AddPicture Foto, True, True, Esquerda, Topo, Largura, Altura

    End If

O que acontece: Toda vez que eu tento inserir uma imagem com um tamanho grande (Ex.: 4 Mb), a macro da um erro nessa linha:

ActiveSheet.Shapes.AddPicture Foto, True, True, Esquerda, Topo, Largura, Altura

Então eu vou la, pego a foto e redimensiono para deixar com um tamanho menor (Ex.: 400 Kb), e a macro roda perfeitamente.
Teria alguma solução?

Muito obrigado e um ótimo dia a vocês.

 
Postado : 28/04/2017 12:18 am
 Alvaro
(@alvaro)
Posts: 78
Trusted Member
Topic starter
 

Pessoal, alguma luz?
Me desculpem insistir no assunto rsrs

 
Postado : 07/05/2017 7:39 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Alvaro, o ideal seria colocar qual a mensagem de erro, pois a rotina está correta, fiz um teste com imagem "jpg" de 6 mb e não deu nenhum erro.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 07/05/2017 9:52 am
 Alvaro
(@alvaro)
Posts: 78
Trusted Member
Topic starter
 

Oi Mauro, bom dia. Me desculpe pela demora.
o Erro é o seguinte.

Muito obrigado por sua atenção.

 
Postado : 07/05/2017 11:06 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Alvaro, a rotina que postou está completa ?
Fiz vários testes e não da nenhum erro, fiz uma adaptação conforme uma rotina indicada no lik - http://stackoverflow.com/questions/2207 ... d-resizing, teste e veja se ainda da erro, se der procure usar a rotina do link para testar.

Sub teste()
    Dim MySht As Worksheet
    Dim MyPic As Shape
    Dim Foto As Variant
    Dim Esquerda, Topo, Largura, Altura As Single

    Foto = Application.GetOpenFilename("Imagem (*.jpg;*.jpeg;*.gif;.*png), *.jpg;*.gif;*.jpeg;*.png,Todas (*.*), *.*", Empty, "Desenvolvido por.: Álvaro Horta e Suely Soares", Empty, Empty)
    
    Esquerda = ActiveCell.Left + 1
    Topo = ActiveCell.Top + 1
    Largura = ActiveCell.Width - 1
    Altura = ActiveCell.Height - 1

    If Foto <> False Then
        Set MySht = ActiveSheet
        
        Set MyPic = MySht.Shapes.AddPicture(Foto, True, True, Esquerda, Topo, Largura, Altura)
                    
        'Set MyPic = MySht.Shapes.AddPicture(Foto, msoFalse, msoTrue, Esquerda, Topo, -1, -1)
                    
    End If
    
End Sub

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 08/05/2017 4:47 pm
 Alvaro
(@alvaro)
Posts: 78
Trusted Member
Topic starter
 

Olá Mauro, me perdoa a demora em responder, estava viajando e retornei ontem a noite.
Bom, primeiramente a rotina que eu postei esta completa (Como eu estou usando atualmente).
Eu fiz o teste com o código que você disponibilizou e mesmo assim deu o mesmo erro.

Agora uma coisa que me chamou a atenção foi que:
Eu copiei uma foto no computador da empresa onde eu trabalho (Foto que estava dando o problema), e trouxe para meu computador pessoal juntamente com a planilha.
Fiz o teste em casa no meu computador pessoal, e rodou perfeitamente, tanto com o código que eu disponibilizei quanto com o código que você disponibilizou.

 
Postado : 11/05/2017 3:10 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico