Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Copiar informação d...
 
Notifications
Clear all

Copiar informação de um grupo de células em uma aba, colar como imagem e formatar essa imagem em outra aba

 
2024 - VBA & Macros
Post Recente por cmbruno 4 anos atrás
3 Posts
2 Usuários
1 Reactions
1,372 Visualizações
RSS
 cmbruno
(@cmbruno)
Posts: 73
Estimable Member
Topic starter
 

Boa tarde,

Pessoal, preciso criar uma macro onde eu vou copiar informações que estão em determinadas celulas em uma aba e vou colar essa informação em outra aba porém no formato de imagem ( formatar o tamanho, rotação , etc ).

Consegui usando o gravador de macros criar a que esta abaixo, porém quando vou executar novamente ela até cola a informação na outra aba mas não executa a formatação e cai em erro para deputar. 

Alguem consegue dar um auxilio?

 

Na aba planilha 2 tem o exemplo de como a imagem deve ficar formata ( imagem na vertical ) e imagem que traz ao gerar novamente a macro ( imagem na horizontal )

 

Abaixo a macro que criei com o gravador de macros e em anexo a planilha de exemplo.

Sub Copiar_colar_imagem()
'
' Copiar_colar_imagem Macro
'

Sheets("Centro").Select
Range("A1:P5").Select
Selection.Copy
Sheets("Planilha2").Select
ActiveSheet.Pictures.Paste.Select
ActiveSheet.Shapes.Range(Array("Picture 1")).Select
Selection.ShapeRange.Rotation = 270
Selection.ShapeRange.IncrementLeft -412.5000787402
Selection.ShapeRange.IncrementTop 21.25
ActiveWindow.SmallScroll Down:=15
Selection.ShapeRange.ScaleWidth 1.2762430493, msoFalse, msoScaleFromBottomRight
Selection.ShapeRange.ScaleHeight 1.2762430939, msoFalse, msoScaleFromTopLeft
ActiveWindow.SmallScroll Down:=-9
End Sub

 
Postado : 21/01/2021 2:33 pm
Mauro Coutinho
 Mauro Coutinho
(@coutinho)
Posts: 95
Estimable Member
 

@cmbruno

O erro ocorre, porque cada vez que uma imagem é criada ela recebe o nome "Picture" alterando o numero, na gravação ela criou a "Picture 1" e qdo se executa novamente é criado a "Picture 2" e assim por diante, gerando o erro na instrução ("Picture 1")).Select

Veja se essa ajuda, qq é só postar.

Sub CopiaColaComoImagem()

ThisWorkbook.Sheets("Centro").Range("A1:P5").CopyPicture Appearance:=xlScreen, Format:=xlBitmap

With Planilha2.Pictures.Paste
   .Left = Range("A1").Left
   .Top = Range("A1").Top
   .ShapeRange.Rotation = 270
   .ShapeRange.IncrementLeft -412
   .ShapeRange.IncrementTop 21.25
End With

End Sub

[]s

Mauro Coutinho

Este post foi modificado 4 anos atrás por Mauro Coutinho
 
Postado : 21/01/2021 4:05 pm
EdsonBR reacted
 cmbruno
(@cmbruno)
Posts: 73
Estimable Member
Topic starter
 

@coutinho, exatamente o que preciso. Muito obrigado pela ajuda.

 
Postado : 21/01/2021 4:21 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico