Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Userform Travando q...
 
Notifications
Clear all

Userform Travando quando roda em uma sequencia específica.

 
2024 - VBA & Macros
6 Posts
2 Usuários
0 Reactions
2,041 Visualizações
RSS
 finaljustice
(@finaljustice)
Posts: 91
Estimable Member
Topic starter
 

Olá pessoal,

Sou novo no fórum, espero conseguir alguma ajudinha aqui pois estou "travado". Meu último projeto tem me dado um pouco de trabalho pois a planilha tem travado dependendo da ordem que executo (ou o usuário interage com a userform). De maneira resumida:

É uma userform que traz cadastro de clientes/ gera uma dropdown com os nomes já cadastrados e traz a informação para o usuário de maneira facil. Esta, também pode efetuar cadastro para clientes e por último gera uma lista baseado na ultima data de contato quais clientes já podem ser contatados.

Não ocorre problemas quando o usuário pesquisa o cliente e cadastra. O problema ocorre se ele fizer uma procura (seja digitando na dropdown ou indo até o nome desejado) e depois ele tenta gerar a lista para contato. Se o usuário abrir a planilha unicamente para gerar essa lista, não ocorre problemas. Parece que a ordem em que o usuário realiza a operação afeta a macro.

Abrir > Pesquisar (todas as funcionalidades dentro dela funcionando)> Gerar Lista = Erro
Abrir > Gerar Lista = Sem Erro
Abrir > Pesquisar (todas as funcionalidades dentro dela funcionando) = Sem Erro

Alguém já viu algo do tipo? Ele simplesmente trava... preciso reiniciar o excel.

Caso solicitem posso disponibilizar o arquivo para testarem.

Isto está em dentro da Userform:

Private Sub ComboBox1_Change()
Dim x As Integer
Application.ScreenUpdating = False
Call Destrav

Sheets("CadastroCliente").Select
Range("B4").Select
    
    Do While ActiveCell <> Empty
        If ActiveCell = UserForm1.ComboBox1 Then
        
        
        UserForm1.TextBox2 = ActiveCell.Offset(0, -1).Value 'cpf
        
        
         For i = 3 To 23
                    Controls("Textbox" & i) = ActiveCell.Offset(0, i - 2)
         Next
    
        
        UserForm1.TextBox22 = Date
        
        End If
        
ActiveCell.Offset(1, 0).Select
    Loop

UserForm1.CommandButton1.Enabled = True
UserForm1.CommandButton2.Enabled = True
Call Trav
End Sub
Private Sub CommandButton1_Click()
Call EditCall
  
End Sub

Private Sub CommandButton2_Click()
Call EditReg

End Sub

Private Sub CommandButton3_Click()
Call Cadastro
End Sub


Private Sub CommandButton4_Click()
ActiveWorkbook.Close True
Application.Quit
End Sub

Private Sub CommandButton5_Click()
UserForm1.Hide

End Sub

Private Sub CommandButton6_Click()
Call Reagenda
End Sub


Private Sub Textbox40_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  Dim objRegex As Object
  Dim objMatches As Object
  Dim strDDMM As String
  Dim strRegex
  strRegex = "^((0[1-9])|([12][0-9])|(3[01]))" & _
    "((0[1-9])|(1[012]))" & _
    "(19|20)?(dd)$"
  Set objRegex = CreateObject("VBScript.Regexp")
  With objRegex
    .Pattern = strRegex
    .Global = False
    Set objMatches = .Execute(TextBox40.Value)
  End With
  If objMatches.Count > 0 Then
    With TextBox40
      strDDMM = Left(.Value, 2) & "/" & Mid(.Value, 3, 2) & "/"
      If Len(.Value) = 6 Then ' user entered ddmmyy
        If Val(Right(.Value, 2)) > 50 Then
          strDDMM = strDDMM & "19"
        Else
          strDDMM = strDDMM & "20"
        End If
        .Value = strDDMM & Right(.Value, 2)
      Else ' user entered ddmmyyyy
        .Value = strDDMM & Right(.Value, 4)
      End If
    End With
    Else ' user entered an invalid date
      MsgBox "Data de aniversário inválida" & vbCrLf & _
        "Favor utilizar um desses formatos de data:" & vbCrLf & _
        "ddmmyy OU ddmmyyyy" & vbCrLf & _
        "Caso esteja dando ERRO CONSISTENTEMENTE é porque a data não foi digitada somente em números!" & vbCrLf & _
        "Portanto selecione a data e redigite somente usando números." & vbCrLf & _
        "O ERRO irá persistir enquanto a data não for REDIGITADA", vbOKOnly + vbCritical, _
        "Erro ao inserir data"
  End If
End Sub

Estes estão em módulos e são chamados:

Public s As Integer
Sub cpf() 'gerar lista de cpf dos clientes e nomes
Sheets("Agenda").Select
Range("A6").Select
Range(Cells(1048576, ActiveCell.Column).End(xlUp), Cells(ActiveCell.Row, 256).End(xlToLeft)).ClearContents

Sheets("CadastroCliente").Select
Sheets("CadastroCliente").Range("A3").Select
'Range(ActiveCell, Cells(ActiveCell.Row, 256).End(xlToLeft)).Select
Range(ActiveCell, Cells(1048576, ActiveCell.Column).End(xlUp)).Name = "listacpf" 'seleciona lista de cpfs cadastrados

Sheets("CadastroCliente").Range("B4").Select
Range(ActiveCell, Cells(1048576, ActiveCell.Column).End(xlUp)).Name = "listanomes"


End Sub
Sub EditCall() ' Acao to botao de alteracao para telefonema
Dim x As Integer
Application.ScreenUpdating = False

Call Destrav

 If UserForm1.CommandButton1.Caption = "Editar para ligação" Then
        For i = 2 To 4
            UserForm1.Controls("ComboBox" & i).Enabled = True
        Next
        For i = 19 To 21
            UserForm1.Controls("Textbox" & i).Enabled = True
        Next
        
        UserForm1.TextBox24.Enabled = True
        UserForm1.CommandButton1.Caption = "Registrar contato"
        
    ElseIf UserForm1.CommandButton1.Caption = "Registrar contato" Then
        For i = 2 To 4
            UserForm1.Controls("ComboBox" & i).Enabled = False
        Next
        For i = 19 To 21
            UserForm1.Controls("Textbox" & i).Enabled = False
        Next
        UserForm1.TextBox24.Enabled = False
        UserForm1.CommandButton1.Caption = "Editar para ligação"
        
        Sheets("CadastroCliente").Select
        Range("B4").Select
        Do While ActiveCell <> Empty
            
            If ActiveCell = UserForm1.ComboBox1 Then
                    
                ActiveCell.Offset(0, 20) = Date
                ActiveCell.Offset(0, 24) = DateAdd("d", UserForm1.ComboBox4, Date)
                ActiveCell.Offset(0, 22) = UserForm1.ComboBox2
                ActiveCell.Offset(0, 23) = UserForm1.ComboBox3
                ActiveCell.Offset(0, 21) = UserForm1.TextBox24
                ActiveCell.Offset(0, 29) = DateAdd("d", UserForm1.ComboBox4, Date) - Date
                For i = 19 To 21
                ActiveCell.Offset(0, i - 2) = UserForm1.Controls("Textbox" & i)
                Next
               'clear phone fields
                For i = 19 To 24
                UserForm1.Controls("Textbox" & i) = ""
                Next
                
                For i = 2 To 4
                UserForm1.Controls("ComboBox" & i) = ""
                Next
            
                
            End If
        
        
        
        ActiveCell.Offset(1, 0).Select
        Loop
    
    
    End If
Call Trav
Application.ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub
Sub EditReg() 'config dos contatos
Dim x As Integer
Application.ScreenUpdating = False

Call Destrav

If UserForm1.CommandButton2.Caption = "Editar Cadastro" Then

    'unlock boxes
    For i = 2 To 18
        UserForm1.Controls("Textbox" & i).Enabled = True
    Next
    
    UserForm1.CommandButton2.Caption = "Salvar alterações"
    
ElseIf UserForm1.CommandButton2.Caption = "Salvar alterações" Then
    Sheets("CadastroCliente").Select
    Range("B4").Select
    Do While ActiveCell <> Empty
        If ActiveCell = UserForm1.ComboBox1 Then
        
            For i = 3 To 18
                ActiveCell.Offset(0, i - 2) = UserForm1.Controls("Textbox" & i) 'preenchendo com as infos para salvar
            Next
        
        End If
        
    ActiveCell.Offset(1, 0).Select
    Loop
    
    For i = 2 To 18
        UserForm1.Controls("Textbox" & i).Enabled = False
    Next

End If

Call Trav
Application.ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub

Sub Cadastro()
Dim x As Integer
Call Destrav
Application.ScreenUpdating = False
    Sheets("CadastroCliente").Select
    Range("B1048576").End(xlUp).Offset(1, 0).Select
    
    If UserForm1.TextBox25 = "" Then
        MsgBox ("Favor preencher os campos acima!")
        Else
        
        For i = 25 To 41
            ActiveCell.Offset(0, i - 25) = UCase(UserForm1.Controls("Textbox" & i))
        Next
        
        For i = 25 To 41
            UserForm1.Controls("Textbox" & i) = ""
        Next
        ActiveCell.Offset(0, -1) = UCase(UserForm1.TextBox42)
    End If
Call cpf
UserForm1.ComboBox1.RowSource = "listanomes"
Call Trav
Application.ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub

Sub Reagenda()
Dim x As Integer
Application.ScreenUpdating = False
Call Destrav
        Sheets("CadastroCliente").Select
        Range("A3").Select
        Range(Cells(1048576, ActiveCell.Column).End(xlUp), Cells(ActiveCell.Row, 256).End(xlToLeft)).AutoFilter Field:=26, Criteria1:="<" & Format(Date, "mm/dd/yyyy")
        Range(Cells(1048576, ActiveCell.Column).End(xlUp), Cells(ActiveCell.Row, 256).End(xlToLeft)).SpecialCells(xlCellTypeVisible).Copy
        Sheets("Agenda").Range("A6").PasteSpecial Paste:=xlPasteAll
        ' If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
        Application.CutCopyMode = False
         
    Call Trav
    
    Sheets("Agenda").Select
    Range("A6").Select
    UserForm1.Hide
Application.ScreenUpdating = True
    
End Sub

Este é um segundo módulo para proteção das planilhas pois tento evitar que funcionários tenham acesso informções que não deveriam:

Sub Showpages()

'Sheets("Interface").Visible = True
Sheets("CadastroCliente").Visible = True
'Sheets("Users").Visible = True

End Sub

Sub Hidepages()
Sheets("Interface").Visible = xlVeryHidden
Sheets("CadastroCliente").Visible = xlVeryHidden
Sheets("Users").Visible = xlVeryHidden
End Sub
Sub Destrav()
Dim x As Integer
Application.ScreenUpdating = False
ActiveWorkbook.Unprotect "projetotahaa"
    For x = 1 To ActiveWorkbook.Sheets.Count
    Sheets(x).Visible = True
    Sheets(x).Unprotect "projetotahaa"
    Next
Application.ScreenUpdating = True
End Sub
Sub Trav()
Dim x As Integer
Application.ScreenUpdating = False
    For x = 2 To ActiveWorkbook.Sheets.Count
    Sheets(x).Protect "projetotahaa"
    Sheets(x).Visible = False
    Next
ActiveWorkbook.Protect "projetotahaa"
Application.ScreenUpdating = True
End Sub
Sub Show()
Call Destrav
UserForm1.Show
End Sub

Gostaria de agradecer a atenção de todos e que ficaria muito grato por qualquer ajuda.

Obrigado,
Final

 
Postado : 11/03/2013 1:11 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

FinalJustice
Sómente pelas rotinas (as mesmas aparentemente estão OK) não apresenta uma possibilidade de visualizar o erro, pois o mesmo muitas vezes,não é somente as linhas do codigo mas uma coletanea de resultados; então teriamos que "montar" os formularios e planilhas para tentar simular o erro.
Então se puder disponibilize seu arquivo, se tiver dados que não possam ser "mostrados" troque-os por ficticios. O arquivo deve ser "upado" compactado em formato Zip ou Rar ou 7z.

 
Postado : 11/03/2013 1:34 pm
 finaljustice
(@finaljustice)
Posts: 91
Estimable Member
Topic starter
 

FinalJustice
Sómente pelas rotinas (as mesmas aparentemente estão OK) não apresenta uma possibilidade de visualizar o erro, pois o mesmo muitas vezes,não é somente as linhas do codigo mas uma coletanea de resultados; então teriamos que "montar" os formularios e planilhas para tentar simular o erro.
Então se puder disponibilize seu arquivo, se tiver dados que não possam ser "mostrados" troque-os por ficticios. O arquivo deve ser "upado" compactado em formato Zip ou Rar ou 7z.

Reinald obrigado pela resposta, nunca fiz isso (disponibilizar o arquivo), qual seria o melhor lugar para hospedar esse tipo de arquivo? Pode ser um MediaFire.com ou algo do gênero?
Assim que tiver uma resposta já providencio o arquivo.
Atenciosamente,

Final

 
Postado : 11/03/2013 2:00 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Pode ser em algum servidor externo de arquivos (tipo o MediaFire ou 4Shared ou SendSpace)
Mas tambem pode ser no proprio forum (VejA como em viewtopic.php?f=7&t=3841)
Lembre-se se for no forum, obrigatoriamente deve ser Compactado (Formato Zip oun Rar ou 7z ou ...)

 
Postado : 11/03/2013 2:03 pm
 finaljustice
(@finaljustice)
Posts: 91
Estimable Member
Topic starter
 

Pode ser em algum servidor externo de arquivos (tipo o MediaFire ou 4Shared ou SendSpace)
Mas tambem pode ser no proprio forum (VejA como em http://www.planilhando.com.br/vie ... f=7&t=3841)
Lembre-se se for no forum, obrigatoriamente deve ser Compactado (Formato Zip oun Rar ou 7z ou ...)

Bom dia, desculpe a demora mas tive que viajar e não tive tempo para colocar o arquivo aqui para amostra. Segue o arquivo zipado para testar, ele não está bonitinho, pois depois vou limpar códigos que nao vou usar interface etc... é mais para resolver o que está dando de errado.

Muito obrigado pela atenção.
final

 
Postado : 15/03/2013 10:47 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Olá
Pelo que pude perceber, qdo gera o relatório sem efetuar uma consulta, essa rotina "roda" normal, sem, problemas; porem se foi efetuada uma consulta/manutenção anteriormente, ao gerar o relatório, é "disparado" a rotina do evento "ComboBox1_Change", então o cursor está em a3 e não se movimenta, gerando assim um loop infinito; a razão real dessa situação eu realmente não sei.
Porem efetuei alterações, que parecem haver contornado o problema.
Teste e veja se atende.

 
Postado : 26/05/2013 9:07 am
Forum Jump:
  Tópico Anterior
Próximo Tópico