Guru do Excel e Power BI

Boa tarde

Pedindo ajuda para tentar melhorar código gerado pelo gravador de macros, então é assim:

Fiz a macro em baixo com recurso ao gravador de macros, sendo que ela serve para copiar um range de uma tab para outra tab, de forma a ficar dinâmico, ou seja, como se trata de um calendário sempre que atualizo o mês, a imagem é atualizada na tab principal.
Fiz os arranjos possíveis dentro dos meus conhecimentos, mas continua a ter "Activate", "Select", "Selection" que não consigo "apagar".
Não sei se é por ignorância minha ou se não dá mesmo para melhorar a macro.
Peço pois ajuda para se possível melhorar e simplificar esta macro:

Código: Selecionar todos

Sub CopyCalendario()

    WsCAL.Range("M17:U24").Copy
    WsT.Range("F1").Activate
    ActiveSheet.Pictures.Paste(Link:=True).Select
    With Selection
        .Formula = "=CALENDARIO!$M$17:$U$24"
        .ShapeRange.Name = "CMensal"
        .ShapeRange.Fill.visible = msoFalse
        .ShapeRange.Line.visible = msoFalse
        .Left = 450
        .Top = 2.5
        .Width = 187.313
        .Height = 178.988
        .OnAction = "....NOME da MACRO AQUI...."
    End With
    Application.CutCopyMode = False
End Sub

Outra coisa que não estou conseguindo é depois de copiar para a tab principal desseleccionar a Shape, sem ter que selecionar uma determinada célula p.ex., é possível?

Obrigado
Jorge

Consegue colocar o arquivo ou parte dele aqui pra ajudar?

Deixo aqui um arquivo com o que se pretende

Verifiquei agora que esta macro só corre sem erro se a Planilha "WsT" estiver ativa, é possível correr esta macro sem que a planilha "WsT" esteja ativa?

Agradeço desde já a ajuda.

Jorge

Código: Selecionar todos

Private Sub CopyCalendario()
    Delete_CAL

    WsCAL.Range("M17:U24").Copy
    
    With ActiveSheet
        .Range("F1").Activate
        
        With .Pictures.Paste(Link:=True)
            .Formula = "=CALENDARIO!$M$17:$U$24"
            
            With .ShapeRange
                .Name = "CMensal"
                .Fill.Visible = msoFalse
                .Line.Visible = msoFalse
            End With
            
            .Left = 450
            .Top = 2.5
            .Width = 187.313
            .Height = 178.988
'           .OnAction = "....NOME da MACRO AQUI...."
        End With
    End With
    Application.CutCopyMode = False
End Sub

Private Sub Delete_CAL()
    On Error Resume Next
    ActiveSheet.Shapes.Range("CMensal").Delete
    On Error GoTo 0
End Sub

@babdallas,

Obrigado pelo seu rearranjo da macro, contudo ela só copia o calendário para uma folha que esteja ativa, como refiro acima.
É possível eu estar com a folha "A" ativa e mandar copiar o calendário para a folha "B"?

Sim, claro. Onde está Activesheet você substitui pelo codename da planilha onde você deseja copiar.

@babdallas,

Dá-me erro em

Código: Selecionar todos

.Range("F1").Activate

O que estou a fazer de errado?

Código completo:

Código: Selecionar todos

Private Sub CopyCalendario_babdallas()
    Delete_CAL_babdallas

    WsCAL.Range("M17:U24").Copy
    
    With WsT
        .Range("F1").Activate
        
        With .Pictures.Paste(Link:=True)
            .Formula = "=CALENDARIO!$M$17:$U$24"
            
            With .ShapeRange
                .Name = "CMensal"
                .Fill.Visible = msoFalse
                .Line.Visible = msoFalse
            End With
            
            .Left = 450
            .Top = 2.5
            .Width = 187.313
            .Height = 178.988
'           .OnAction = "....NOME da MACRO AQUI...."
        End With
    End With
    Application.CutCopyMode = False
End Sub

Private Sub Delete_CAL_babdallas()
    On Error Resume Next
    WsT.Shapes.Range("CMensal").Delete
    On Error GoTo 0
End Sub

Olá, @JCabral .
Veja se ajuda.

Código: Selecionar todos

Sub ReplicaFormataCalendário()
 Dim ws As Worksheet
 Application.ScreenUpdating = False
 Set ws = ActiveSheet
 Delete_CAL
 Sheets("CALENDARIO").Range("M17:U24").CopyPicture xlScreen, xlPicture
 With Sheets("PRINCIPAL")
  .Range("B2").PasteSpecial
  .Pictures(Worksheets(.Name).Pictures.Count).Name = "CMensal"
   With .Shapes("CMensal")
    .DrawingObject.Formula = "=CALENDARIO!$M$17:$U$24"
    .Left = 450
    .Top = 2.5
    .Width = 187.313
    .Height = 178.988
' '  .OnAction = "....NOME da MACRO AQUI...."
   End With
  .Activate: .[M7].Activate
 End With
 ws.Activate
End Sub

Código: Selecionar todos

Private Sub CopyCalendario()
    Delete_CAL

    WsCAL.Range("M17:U24").Copy
    
    With WsT.Pictures.Paste(Link:=True)
        .Formula = "=CALENDARIO!$M$17:$U$24"
        
        With .ShapeRange
            .Name = "CMensal"
            .Fill.Visible = msoFalse
            .Line.Visible = msoFalse
        End With
        
        .Left = 450
        .Top = 2.5
        .Width = 187.313
        .Height = 178.988
'           .OnAction = "....NOME da MACRO AQUI...."
    End With
    Application.CutCopyMode = False
End Sub

Private Sub Delete_CAL()
    On Error Resume Next
    WsT.Shapes.Range("CMensal").Delete
    On Error GoTo 0
End Sub

@babdallas, @osvaldomp,

Muito obrigado a ambos,
Ambas as soluções funcionam na perfeição.

Obrigado

Guru do Excel e Power BI

RESOLVIDO - Melhorar código de macro gerada via gravador de macros

RESOLVIDO - Melhorar código de macro gerada via gravador de macros

Re: Melhorar código de macro gerada via gravador de macros

Re: Melhorar código de macro gerada via gravador de macros

Re: Melhorar código de macro gerada via gravador de macros

Re: Melhorar código de macro gerada via gravador de macros

Re: Melhorar código de macro gerada via gravador de macros

Re: Melhorar código de macro gerada via gravador de macros

Re: Melhorar código de macro gerada via gravador de macros

Re: Melhorar código de macro gerada via gravador de macros

Re: Melhorar código de macro gerada via gravador de macros

Re: Melhorar código de macro gerada via gravador de macros