Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
MsgBox "em and...
 
Notifications
Clear all

MsgBox "em andamento" e não parar o código

 
2024 - VBA & Macros
Post Recente por rafnakb 8 anos atrás
10 Posts
2 Usuários
0 Reactions
1,825 Visualizações
RSS
 rafnakb
(@rafnakb)
Posts: 44
Eminent Member
Topic starter
 

Bom dia.
Gostaria de num determinado ponto do meu código mostrar uma MsgBox com a descrição "Em andamento...", e em seguida fechar a mesma quando chegasse em outra parte do código.... Sem timer... Apenas abre no início do calculo e fecha quando termina o cálculo....
Poderiam me ajudar ???
Como destacado no Exemplo:

Private Sub Salvar_Click()

Dim l As Long
    Dim iRow As Long
    Dim sCodigo As String
    Dim sRw As Long
    Dim wS_1 As Worksheet
    Dim wS_2 As Worksheet
    
    Set wS_1 = Sheets("Estoq")
    Set wS_2 = Sheets("Lançamentos")
    
    'Qde de linhas Plan1
    rang = wS_1.Cells(Rows.Count, 1).End(xlUp).Row
    
    sCodigo = txtmodelo.Value
    
    With wS_1
        Set Rng = .Range(.Cells(2, 1), .Cells(rang, 1))
    End With
    
        With Rng

            Set Rng = .Find(What:=sCodigo, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

            If Not Rng Is Nothing Then
                sRw = Rng.Row
                
[color=#FF0000]MENSAGEM: AGUARDE EM ANDAMENTO...[/color]

                'Lançar na Plan1
                
                wS_1.Cells(sRw, 7).Value2 = Cells(sRw, 7).Value2 + txtfundido.Value
                wS_1.Cells(sRw, 10).Value2 = Cells(sRw, 10).Value2 + txtuse.Value
                wS_1.Cells(sRw, 11).Value2 = Cells(sRw, 11).Value2 + txtuss.Value
                wS_1.Cells(sRw, 13).Value2 = Cells(sRw, 13).Value2 + txtentrada.Value
                wS_1.Cells(sRw, 14).Value2 = Cells(sRw, 14).Value2 + txtdeffund.Value
                wS_1.Cells(sRw, 15).Value2 = Cells(sRw, 15).Value2 + txtdefus.Value
                wS_1.Cells(sRw, 17).Value2 = Cells(sRw, 17).Value2 + txtdeff.Value
                wS_1.Cells(sRw, 22).Value2 = Cells(sRw, 22).Value2 + txtalmoe.Value
                wS_1.Cells(sRw, 23).Value2 = Cells(sRw, 23).Value2 + txtalmos.Value
                                             
                               
                    'Lançar na Plan2
                    iRow = wS_2.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
                    'Carregar os dados digitados nas caixas de texto para a planilha
                    wS_2.Cells(iRow, 1).Value = CDate(Me.txtdata.Value)
                    wS_2.Cells(iRow, 2).Value = Me.txtmodelo.Value
                    wS_2.Cells(iRow, 3).Value = Me.txttotal.Value
                    wS_2.Cells(iRow, 4).Value = Me.txtdeffund.Value
                    wS_2.Cells(iRow, 5).Value = Me.txtdefus.Value
                    wS_2.Cells(iRow, 6).Value = Me.txtdeff.Value
                    wS_2.Cells(iRow, 7).Value = Me.txtentrada.Value
                    wS_2.Cells(iRow, 8).Value = Me.dup.Value
                    wS_2.Cells(iRow, 9).Value = Me.due.Value
                    wS_2.Cells(iRow, 10).Value = Me.dui.Value
                    wS_2.Cells(iRow, 11).Value = Me.duc.Value
                    wS_2.Cells(iRow, 12).Value = Me.duch.Value
                    wS_2.Cells(iRow, 13).Value = Me.duca.Value
                    wS_2.Cells(iRow, 14).Value = Me.duf.Value
                    wS_2.Cells(iRow, 15).Value = Me.dua.Value
                    wS_2.Cells(iRow, 16).Value = Me.duen.Value
                    wS_2.Cells(iRow, 17).Value = Me.dfe.Value
                    wS_2.Cells(iRow, 18).Value = Me.dfi.Value
                    wS_2.Cells(iRow, 19).Value = Me.dfc.Value
                    wS_2.Cells(iRow, 20).Value = Me.txtalmoe.Value
                    wS_2.Cells(iRow, 21).Value = Me.txtalmos.Value
                    wS_2.Cells(iRow, 22).Value = Me.txtfundido.Value
                    wS_2.Cells(iRow, 23).Value = Me.txtuse.Value
                    wS_2.Cells(iRow, 24).Value = Me.txtuss.Value
                
   [color=#FF0000]MENSAGEM FECHA[/color]             

                MsgBox "Registrado com Sucesso!"
                
                Else
                
                MsgBox "Código Não Encontrado!", vbCritical, "Alerta da Procura"
                
            End If
    
    End With
    
    'Limpar as caixas de texto
txtmodelo.Value = Empty
txttotal.Value = 0
txtdeffund.Value = 0
txtdefus.Value = 0
txtdeff.Value = 0
txtentrada.Value = 0
dup.Value = 0
due.Value = 0
dui.Value = 0
duc.Value = 0
duch.Value = 0
duca.Value = 0
duf.Value = 0
dua.Value = 0
duen.Value = 0
dfe.Value = 0
dfi.Value = 0
dfc.Value = 0
txtalmoe.Value = 0
txtalmos.Value = 0
txtfundido.Value = 0
txtuse.Value = 0
txtuss.Value = 0


    'Colocar o foco na primeira caixa de texto
    txtmodelo.SetFocus
     

End Sub
 
Postado : 03/08/2016 5:33 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

raf, acho que está se referindo a Barra de Progresso, veja um exemplo no Forum Biblioteca :
Barra de Progresso (ProgressBar)
viewtopic.php?f=21&t=10557&p=83309&hilit=BARRA&sid=865e0bf11c12a20b1a56f94d0bedc879#p83309

Apesar que na rotina proposta a execução da mesma não envolve muitos procedimentos e por estar trabalhando com um único código por vez, ela deve ser rápida que nem perceberá a execução de uma Barra de Progresso.

[]s

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

 
Postado : 03/08/2016 6:10 am
 rafnakb
(@rafnakb)
Posts: 44
Eminent Member
Topic starter
 

Obrigado Mauro Coutinho. Eu vi esse post da barra de progresso...
É apenas um alerta mesmo "Em andamento"...
Como estou trabalhando com uma planilha com muitos dados e cada dado leva ou faz determinada função,
está levando cerca de 4 a 5 segundos para fazer o lançamento....
Então qria só mostrar um MsgBox para o usuário não achar que travou..

Há essa possibilidade dentro do código citado ?

 
Postado : 03/08/2016 6:15 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

quando vc cria e abre um formulario, vc pode escolher se ele é vbmodal ou não.
Esta propriedade/parametro do Userform1.Show determinará se o código poderá continuar rodando depois da exibição do formulário

Você não conseguirá fazer isso com uma msgbox, visto que a msgbox para o código até que seja respondida...

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

 
Postado : 03/08/2016 7:29 am
 rafnakb
(@rafnakb)
Posts: 44
Eminent Member
Topic starter
 

Obrigado, Fernando... Vou ter então que deixar como está...

 
Postado : 03/08/2016 8:03 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Vocè pode também, se não for mto ruim pra vc, usar o application.statusbar...

Vc escreve no início e no fim do código:

sub rotina()
    Application.Statusbar="Rodando, em execução, calma, já já termina"

    'todo seu código, mil linhas, etc etc

    Application.Statusbar= False
end sub

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

 
Postado : 03/08/2016 8:09 am
 rafnakb
(@rafnakb)
Posts: 44
Eminent Member
Topic starter
 

Como ficaria esse código nessa situação ?
Não entendi onde encaixo ele ?

Private Sub Salvar_Click()

Dim l As Long
    Dim iRow As Long
    Dim sCodigo As String
    Dim sRw As Long
    Dim wS_1 As Worksheet
    Dim wS_2 As Worksheet
    
    Set wS_1 = Sheets("Estoq")
    Set wS_2 = Sheets("Lançamentos")
    
    'Qde de linhas Plan1
    rang = wS_1.Cells(Rows.Count, 1).End(xlUp).Row
    
    sCodigo = txtmodelo.Value
    
    With wS_1
        Set Rng = .Range(.Cells(2, 1), .Cells(rang, 1))
    End With
    
        With Rng

            Set Rng = .Find(What:=sCodigo, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

            If Not Rng Is Nothing Then
                sRw = Rng.Row
                
[color=#FF0000]MENSAGEM: AGUARDE EM ANDAMENTO...[/color]

                'Lançar na Plan1
                
                wS_1.Cells(sRw, 7).Value2 = Cells(sRw, 7).Value2 + txtfundido.Value
                wS_1.Cells(sRw, 10).Value2 = Cells(sRw, 10).Value2 + txtuse.Value
                wS_1.Cells(sRw, 11).Value2 = Cells(sRw, 11).Value2 + txtuss.Value
                wS_1.Cells(sRw, 13).Value2 = Cells(sRw, 13).Value2 + txtentrada.Value
                wS_1.Cells(sRw, 14).Value2 = Cells(sRw, 14).Value2 + txtdeffund.Value
                wS_1.Cells(sRw, 15).Value2 = Cells(sRw, 15).Value2 + txtdefus.Value
                wS_1.Cells(sRw, 17).Value2 = Cells(sRw, 17).Value2 + txtdeff.Value
                wS_1.Cells(sRw, 22).Value2 = Cells(sRw, 22).Value2 + txtalmoe.Value
                wS_1.Cells(sRw, 23).Value2 = Cells(sRw, 23).Value2 + txtalmos.Value
                                             
                               
                    'Lançar na Plan2
                    iRow = wS_2.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
                    'Carregar os dados digitados nas caixas de texto para a planilha
                    wS_2.Cells(iRow, 1).Value = CDate(Me.txtdata.Value)
                    wS_2.Cells(iRow, 2).Value = Me.txtmodelo.Value
                    wS_2.Cells(iRow, 3).Value = Me.txttotal.Value
                    wS_2.Cells(iRow, 4).Value = Me.txtdeffund.Value
                    wS_2.Cells(iRow, 5).Value = Me.txtdefus.Value
                    wS_2.Cells(iRow, 6).Value = Me.txtdeff.Value
                    wS_2.Cells(iRow, 7).Value = Me.txtentrada.Value
                    wS_2.Cells(iRow, 8).Value = Me.dup.Value
                    wS_2.Cells(iRow, 9).Value = Me.due.Value
                    wS_2.Cells(iRow, 10).Value = Me.dui.Value
                    wS_2.Cells(iRow, 11).Value = Me.duc.Value
                    wS_2.Cells(iRow, 12).Value = Me.duch.Value
                    wS_2.Cells(iRow, 13).Value = Me.duca.Value
                    wS_2.Cells(iRow, 14).Value = Me.duf.Value
                    wS_2.Cells(iRow, 15).Value = Me.dua.Value
                    wS_2.Cells(iRow, 16).Value = Me.duen.Value
                    wS_2.Cells(iRow, 17).Value = Me.dfe.Value
                    wS_2.Cells(iRow, 18).Value = Me.dfi.Value
                    wS_2.Cells(iRow, 19).Value = Me.dfc.Value
                    wS_2.Cells(iRow, 20).Value = Me.txtalmoe.Value
                    wS_2.Cells(iRow, 21).Value = Me.txtalmos.Value
                    wS_2.Cells(iRow, 22).Value = Me.txtfundido.Value
                    wS_2.Cells(iRow, 23).Value = Me.txtuse.Value
                    wS_2.Cells(iRow, 24).Value = Me.txtuss.Value
                
   [color=#FF0000]MENSAGEM FECHA[/color]             

                MsgBox "Registrado com Sucesso!"
                
                Else
                
                MsgBox "Código Não Encontrado!", vbCritical, "Alerta da Procura"
                
            End If
    
    End With
    
    'Limpar as caixas de texto
txtmodelo.Value = Empty
txttotal.Value = 0
txtdeffund.Value = 0
txtdefus.Value = 0
txtdeff.Value = 0
txtentrada.Value = 0
dup.Value = 0
due.Value = 0
dui.Value = 0
duc.Value = 0
duch.Value = 0
duca.Value = 0
duf.Value = 0
dua.Value = 0
duen.Value = 0
dfe.Value = 0
dfi.Value = 0
dfc.Value = 0
txtalmoe.Value = 0
txtalmos.Value = 0
txtfundido.Value = 0
txtuse.Value = 0
txtuss.Value = 0


    'Colocar o foco na primeira caixa de texto
    txtmodelo.SetFocus
     

End Sub
 
Postado : 03/08/2016 10:19 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

É simples...

Private Sub Salvar_Click()
application.statusbar = "está rodando, muita calma nessa hora"
' TODO O SEU CÓDIGO
application.statusbar = false
End Sub

Assim:

Private Sub Salvar_Click()
application.statusbar = "está rodando, muita calma nessa hora"
Dim l As Long
    Dim iRow As Long
    Dim sCodigo As String
    Dim sRw As Long
    Dim wS_1 As Worksheet
    Dim wS_2 As Worksheet
    
    Set wS_1 = Sheets("Estoq")
    Set wS_2 = Sheets("Lançamentos")
    
    'Qde de linhas Plan1
    rang = wS_1.Cells(Rows.Count, 1).End(xlUp).Row
    
    sCodigo = txtmodelo.Value
    
    With wS_1
        Set Rng = .Range(.Cells(2, 1), .Cells(rang, 1))
    End With
    
        With Rng

            Set Rng = .Find(What:=sCodigo, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

            If Not Rng Is Nothing Then
                sRw = Rng.Row
                
[color=#FF0000]MENSAGEM: AGUARDE EM ANDAMENTO...[/color]

                'Lançar na Plan1
                
                wS_1.Cells(sRw, 7).Value2 = Cells(sRw, 7).Value2 + txtfundido.Value
                wS_1.Cells(sRw, 10).Value2 = Cells(sRw, 10).Value2 + txtuse.Value
                wS_1.Cells(sRw, 11).Value2 = Cells(sRw, 11).Value2 + txtuss.Value
                wS_1.Cells(sRw, 13).Value2 = Cells(sRw, 13).Value2 + txtentrada.Value
                wS_1.Cells(sRw, 14).Value2 = Cells(sRw, 14).Value2 + txtdeffund.Value
                wS_1.Cells(sRw, 15).Value2 = Cells(sRw, 15).Value2 + txtdefus.Value
                wS_1.Cells(sRw, 17).Value2 = Cells(sRw, 17).Value2 + txtdeff.Value
                wS_1.Cells(sRw, 22).Value2 = Cells(sRw, 22).Value2 + txtalmoe.Value
                wS_1.Cells(sRw, 23).Value2 = Cells(sRw, 23).Value2 + txtalmos.Value
                                             
                               
                    'Lançar na Plan2
                    iRow = wS_2.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
                    'Carregar os dados digitados nas caixas de texto para a planilha
                    wS_2.Cells(iRow, 1).Value = CDate(Me.txtdata.Value)
                    wS_2.Cells(iRow, 2).Value = Me.txtmodelo.Value
                    wS_2.Cells(iRow, 3).Value = Me.txttotal.Value
                    wS_2.Cells(iRow, 4).Value = Me.txtdeffund.Value
                    wS_2.Cells(iRow, 5).Value = Me.txtdefus.Value
                    wS_2.Cells(iRow, 6).Value = Me.txtdeff.Value
                    wS_2.Cells(iRow, 7).Value = Me.txtentrada.Value
                    wS_2.Cells(iRow, 8).Value = Me.dup.Value
                    wS_2.Cells(iRow, 9).Value = Me.due.Value
                    wS_2.Cells(iRow, 10).Value = Me.dui.Value
                    wS_2.Cells(iRow, 11).Value = Me.duc.Value
                    wS_2.Cells(iRow, 12).Value = Me.duch.Value
                    wS_2.Cells(iRow, 13).Value = Me.duca.Value
                    wS_2.Cells(iRow, 14).Value = Me.duf.Value
                    wS_2.Cells(iRow, 15).Value = Me.dua.Value
                    wS_2.Cells(iRow, 16).Value = Me.duen.Value
                    wS_2.Cells(iRow, 17).Value = Me.dfe.Value
                    wS_2.Cells(iRow, 18).Value = Me.dfi.Value
                    wS_2.Cells(iRow, 19).Value = Me.dfc.Value
                    wS_2.Cells(iRow, 20).Value = Me.txtalmoe.Value
                    wS_2.Cells(iRow, 21).Value = Me.txtalmos.Value
                    wS_2.Cells(iRow, 22).Value = Me.txtfundido.Value
                    wS_2.Cells(iRow, 23).Value = Me.txtuse.Value
                    wS_2.Cells(iRow, 24).Value = Me.txtuss.Value
                
   [color=#FF0000]MENSAGEM FECHA[/color]             

                MsgBox "Registrado com Sucesso!"
                
                Else
                
                MsgBox "Código Não Encontrado!", vbCritical, "Alerta da Procura"
                
            End If
    
    End With
    
    'Limpar as caixas de texto
txtmodelo.Value = Empty
txttotal.Value = 0
txtdeffund.Value = 0
txtdefus.Value = 0
txtdeff.Value = 0
txtentrada.Value = 0
dup.Value = 0
due.Value = 0
dui.Value = 0
duc.Value = 0
duch.Value = 0
duca.Value = 0
duf.Value = 0
dua.Value = 0
duen.Value = 0
dfe.Value = 0
dfi.Value = 0
dfc.Value = 0
txtalmoe.Value = 0
txtalmos.Value = 0
txtfundido.Value = 0
txtuse.Value = 0
txtuss.Value = 0


    'Colocar o foco na primeira caixa de texto
    txtmodelo.SetFocus
     
application.statusbar = false
End Sub

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

 
Postado : 03/08/2016 10:23 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

A implementação de uma Barra de Progresso corre de acordo com o tempo que determinadas ações ocorrem, ela não capta automaticamente o processamento, então 4 ou 5 segundos vai ser o tempo de abrir e fechar a barra sem conseguir visualiza-la corretamente, e para isto teria de aumentar o tempo o que prejudicaria na performance.

Faça um teste adicionando um Label em sue form e na rotina do botão salvar coloque :

Label1.Caption = "Em processamento . . Aguarde ... !"

e antes da msgbox "Registrado com sucesso" coloque

Label1.Caption = "Processo Terminado !"

Formate o label para ficar bem visivel e rode sua rotina e veja se consegue ler a primeira mensagem.

Uma outra dica tambem é dar uma limpada em seu projeto eliminando rotinas e linhas desnecessárias, isto ajuda no ganho de performance.

[]s

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

 
Postado : 03/08/2016 11:04 am
 rafnakb
(@rafnakb)
Posts: 44
Eminent Member
Topic starter
 

Obrigado Ferando e Mauro pela orientação..
Vou experimentar ambos os jeitos e ver qual procedimento vou tomar..

Grato

 
Postado : 03/08/2016 11:23 am
Forum Jump:
  Tópico Anterior
Próximo Tópico