Como colocar Janela de aviso de processamento de macro?

[RicardoVCM]

Olá, eu fiz um macro para corrigir os filtros de segmentações de dados em relatórios da minha empresa.

 

Este macro está bem genérico e simples, pois além de eu não dominar o VBA, eu preciso que este macro funcione em outros relatórios parecidos.

 

Eu queria colocar um aviso na tela, se possível no meio da tabela, quando o macro está sendo executado. Não precisa ter barra de progresso, nem nada, só um "Please Wait..." para as pessoas saberem que o macro ainda está em execução.

 

Eu levei uma surra com uma "Userform" que funcionava em uma planilha em branco, mas quando eu tentava adaptar para o meu macro, simplesmente nao aparecia nenhuma mensagem.

 

Segue o meu macro:

Sub Filtros_Automáticos()    Range("A1").Select    ActiveWorkbook.RefreshAll    ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Último_Status"). _        ClearManualFilter    With ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Último_Status")        .SlicerItems("520").Selected = False        .SlicerItems("522").Selected = False        .SlicerItems("524").Selected = False        .SlicerItems("527").Selected = False        .SlicerItems("533").Selected = False        .SlicerItems("534").Selected = False        .SlicerItems("535").Selected = False        .SlicerItems("545").Selected = False        .SlicerItems("545").Selected = False        .SlicerItems("595").Selected = False        .SlicerItems("599").Selected = False        .SlicerItems("620").Selected = True        .SlicerItems("900").Selected = False        .SlicerItems("902").Selected = False        .SlicerItems("(vazio)").Selected = False    End With        ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Último_Status1"). _        ClearManualFilter    With ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Último_Status1")        .SlicerItems("520").Selected = False        .SlicerItems("522").Selected = False        .SlicerItems("524").Selected = False        .SlicerItems("527").Selected = False        .SlicerItems("533").Selected = True        .SlicerItems("534").Selected = True        .SlicerItems("535").Selected = False        .SlicerItems("545").Selected = False        .SlicerItems("545").Selected = False        .SlicerItems("595").Selected = False        .SlicerItems("599").Selected = False        .SlicerItems("620").Selected = False        .SlicerItems("900").Selected = False        .SlicerItems("902").Selected = False        .SlicerItems("(vazio)").Selected = False    End With        ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Último_Status2"). _        ClearManualFilter    With ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Último_Status2")        .SlicerItems("520").Selected = False        .SlicerItems("522").Selected = False        .SlicerItems("524").Selected = False        .SlicerItems("527").Selected = True        .SlicerItems("533").Selected = False        .SlicerItems("534").Selected = False        .SlicerItems("535").Selected = False        .SlicerItems("545").Selected = False        .SlicerItems("545").Selected = False        .SlicerItems("595").Selected = False        .SlicerItems("599").Selected = False        .SlicerItems("620").Selected = False        .SlicerItems("900").Selected = False        .SlicerItems("902").Selected = False        .SlicerItems("(vazio)").Selected = False    End With        ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Último_Status3"). _        ClearManualFilter            With ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Último_Status3")    End With        ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Último_Status4"). _        ClearManualFilter    With ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Último_Status4")        .SlicerItems("520").Selected = True        .SlicerItems("522").Selected = True        .SlicerItems("524").Selected = True        .SlicerItems("527").Selected = True        .SlicerItems("533").Selected = True        .SlicerItems("534").Selected = True        .SlicerItems("535").Selected = True        .SlicerItems("545").Selected = True        .SlicerItems("545").Selected = True        .SlicerItems("595").Selected = True        .SlicerItems("599").Selected = True        .SlicerItems("620").Selected = False        .SlicerItems("900").Selected = True        .SlicerItems("902").Selected = True        .SlicerItems("(vazio)").Selected = True    End With        ActiveCell.Cells.Select    ActiveCell.Cells.EntireColumn.AutoFit    ActiveCell.Offset(12, 1).Range("A1").SelectEnd Sub

E este é o macro que eu encontrei e que tentei adaptar:

      Sub DisplayTextMsgBox()         ' Select the first worksheet.         Worksheets(1).Select         ' Create a text box on the active worksheet.         ActiveSheet.TextBoxes.Add(215, 195, 91.5, 60).Select         ' Store the name of Worksheet in variable StoreWSNM.         StoreWSNM = ActiveSheet.Name         ' Store the name of Text Box in variable StoreNM         StoreNM = Selection.Name         ' Set the Font and Border properties of the text box.         With Selection            With Selection.Characters.Font               .Name = "Arial"               .FontStyle = "Bold"               .Size = 20            End With            With Selection.Border               .LineStyle = xlContinuous               .ColorIndex = 1               .Weight = xlThick            End With            'Set round corners for the text box.            .RoundedCorners = True            'Set message text color to black.            .Interior.ColorIndex = 15            'Assign message text to the text box.            .Characters.Text = "Please Wait..."         End With         ' Actual macro that will run while Please Wait...         ' message is being displayed.         Second_Macro         ' Makes sure the proper Worksheet is selected.         Worksheets(StoreWSNM).Select         ' Makes sure the proper text box is selected.         ActiveSheet.TextBoxes(StoreNM).Select         ' Deletes the Please Wait... text box.         Selection.Delete      End Sub      ' Note that the Please Wait... text box will be displayed      ' until this macro has completed.      Sub Second_Macro()         ' Select A1 and copies it.         Range("a1").Select         ActiveCell.Copy         ' Set loop to occur 5 times.         For LoopIt = 1 To 5            ' Move down one row and paste the contents of A1.            ActiveCell.Offset(1, 0).Select            ActiveSheet.Paste            ' Waits one second before looping.            ' NOTE: This is only done for demonstration purposes to            ' slow down the macro so the Please Wait text box will            ' be displayed for at least 5 seconds.            Application.Wait Now + TimeValue("00:00:01")         Next      End Sub

Este modelo é exatamente o que eu queria, mas não consegui adaptar.

 

Alguem pode me ajudar?

[RicardoVCM]

Acabei de verificar que o código:

ActiveCell.Cells.SelectActiveCell.Cells.EntireColumn.AutoFitActiveCell.Offset(12, 1).Range("A1").Select

Que eu coloquei para ajustar o tamanho das células também não funcionou.

 

Então podem desconsiderar estas linhas, obrigado.

[Basole]

Ricardo, seja bem vindo a bordo!

 

Normalmente eu utilizo a Application,StatusBar (display na parte de baixo a esquerda), para informar o usuario sobre o progresso da macro. 

Mas vamos a seu caso. Minha sugestão é eliminar a 'Second_Macro()' e no lugar dela a sua macro: 'Filtros_Automáticos()'.

voce executa a macro 'DisplayTextMsgBox()' esta macro ativa a caixa de texto (texbox), chama a macro 'Filtros_Au...' depois  retorna e deleta a msg (cx. de texto). 

 

Então o codigo fica assim: 

 

Sub DisplayTextMsgBox()
' Select the first worksheet.
    Worksheets(1).Select

    ' Create a text box on the active worksheet.
    ActiveSheet.TextBoxes.Add(215, 195, 91.5, 60).Select

    ' Store the name of Worksheet in variable StoreWSNM.
    StoreWSNM = ActiveSheet.Name

    ' Store the name of Text Box in variable StoreNM
    StoreNM = Selection.Name

    ' Set the Font and Border properties of the text box.
    With Selection
        With Selection.Characters.Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 20
        End With
        With Selection.Border
            .LineStyle = xlContinuous
            .ColorIndex = 1
            .Weight = xlThick
        End With

        'Set round corners for the text box.
        .RoundedCorners = True

        'Set message text color to black.
        .Interior.ColorIndex = 15

        'Assign message text to the text box.
        .Characters.Text = "Please Wait..."
    End With

    ' Actual macro that will run while Please Wait...
    ' message is being displayed.
     'Second_Macro ' desabilitada a "Second Macro"
    Call Filtros_Automáticos   ' AQUI:    Chama a sua macro
    ' Makes sure the proper Worksheet is selected.
    Worksheets(StoreWSNM).Select

    ' Makes sure the proper text box is selected.
    ActiveSheet.TextBoxes(StoreNM).Select

    ' Deletes the Please Wait... text box.
    Selection.Delete
End Sub

 

'abx.

[RicardoVCM]

Perfeito @Basole!

 

Problema resolvido!

 

E muito obrigado pelas boas vindas!

[RicardoVCM]

Não sei se posso usar o mesmo tópíco, mas vou tentar. rs

 

Este código de segmentação busca por valores como "620", "527", "533", etc.

 

Mas no documento que eu extraio do sistema, nem sempre tem uma linha com este código, vamos supor que tenha só "620", ou seja, não contém os outros, então o macro da erro "1004".

 

Vocês podem me dizer se existe uma forma de coloca-lo para conferir se há aquele filtro antes dele selecionar?

Como se fosse um código tipo:

If exist "620" .SlicerItems("620").Selected = True

Sei que este código não funciona, só dando uma ideia.

 

Obrigado.

[Basole]

Haja tanto " IF'" p/ voce atender tantas consdiçoes do seu codigo !!

 

Já tentou usar o  " On Error Resume Next " ?  Se houver algum error a macro continua....

 

Sub Filtros_Automáticos()
    Range("A1").Select
    ActiveWorkbook.RefreshAll
    
    On Error Resume Next
    
With Plan1
    ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Último_Status"). _
        ClearManualFilter
    With ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Último_Status")
        .SlicerItems("520").Selected = False
        .SlicerItems("522").Selected = False
        .SlicerItems("524").Selected = False
        .SlicerItems("527").Selected = False
        '........................................
        '.........................................

abx. 

[RicardoVCM]

Hahaha... eu pensei nisso... ficaria uns dias editando este código.

 

Não estou com acesso ao arquivo agora, mas quando eu entrar eu vou testar e se der certo e coloco resolvido aqui.