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

VBA & Macros

Post Recente por cmbruno 3 anos atrás

3 Posts

2 Usuários

1 Likes

1,112 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

Exemplo.xlsm

Postado : 21/01/2021 2:33 pm

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 3 anos atrás por Mauro Coutinho

Postado : 21/01/2021 4:05 pm

EdsonBR reacted