Jump to content
Fórum Script Brasil
  • 0

Do While


Avilez
 Share

Question

Olá galera,

Bem, eu comecei os meus estudos sobre VBA a pouquíssimo(ontem, para ser mais exato 12/07) tempo e a minha vontade de aprender é muito grande!

Pesquisando sobre os comandos de loop, cheguei ao DO WHILE, a minha idéia é varrer toda uma coluna para que, na hora de cadastrar uma pessoa, não cadastre em cima de uma já existente. Aparentemente o comando DO WHILE está todo correto mas o mesmo não é executado! Alguém pode me ajudar?

Grato desde já. :)

Option Explicit
Public Linha As Integer


Private Sub cmdCadComi_Click()
If lblNome.Value = "" Then
MsgBox "Por favor,preencha todos os campos"
End
ElseIf (Val(masc1) Or Val(masc2) Or Val(masc3) Or Val(fem1) Or Val(fem2) Or Val(fem3)) > 300 Then
MsgBox "Não é possível registrar esta quantidade de Ingressos.", vbOKOnly
End
Else
Do While Range("A" & Linha).Value <> Empty
Linha = Linha + 1
Loop
Worksheets("Comissários").Activate
Linha = Linha + 1
Range("A" & Linha).Value = lblNome
Range("B" & Linha).Value = Val(masc1)
Range("C" & Linha).Value = Val(fem1)
Range("D" & Linha).Value = Val(fem1) + Val(masc1)
Range("I" & Linha).Value = Val(masc2)
Range("J" & Linha).Value = Val(fem2)
Range("K" & Linha).Value = Val(fem2) + Val(masc2)
Range("P" & Linha).Value = Val(masc3)
Range("Q" & Linha).Value = Val(fem3)
Range("R" & Linha).Value = Val(fem3) + Val(masc3)
If CheckBox1 = True Then
Range("W" & Linha).Value = Fix(((Val(fem1) + Val(masc1) + Val(fem2) + Val(masc2) + Val(fem3) + Val(masc3)) / 10))
End If
End If
'Limpar os campos
lblNome.Value = ""
masc1.Value = ""
masc2.Value = ""
masc3.Value = ""
fem1.Value = ""
fem2.Value = ""
fem3.Value = ""

MsgBox "Cadastro de " & Range("A" & Linha).Value & " realizado com sucesso!", vbOKOnly
Worksheets("Menu").Activate

End Sub
Public Sub Form_KeyPress(KeyAscii As Integer)
'Esse código permite a mudança de quadro de
'texto através do Enter
If KeyAscii = 13 Then
'Se o tipo do controle ativo for TextBox
If TypeOf Screen.ActiveControl Is TextBox Then
'Simula o pressionamento da tecla TAB
SendKeys "{tab}"
'A linha a seguir evita ouvir um bip
KeyAscii = 0
End If
End If
End Sub


Private Sub cmdSair_Click()
Unload Me
End Sub



Private Sub fem1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim strValid As String
strValid = "0123456789"

If InStr(strValid, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub


Private Sub fem2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim strValid As String
strValid = "0123456789"

If InStr(strValid, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub

Private Sub fem3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim strValid As String
strValid = "0123456789"

If InStr(strValid, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub

Private Sub masc1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim strValid As String
strValid = "0123456789"

If InStr(strValid, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If

End Sub


Private Sub masc2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim strValid As String
strValid = "0123456789"

If InStr(strValid, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub


Private Sub masc3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim strValid As String
strValid = "0123456789"

If InStr(strValid, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub

Private Sub UserForm_Initialize()
If Linha = 0 Then
Linha = 1
Else
End If
End Sub
[/codebox]

Edited by Avilez
Link to comment
Share on other sites

2 answers to this question

Recommended Posts

  • 0

desculpa pelo post duplo, mas é que achei a solução e essa pode ser a dúvida de alguém!

A minha solução foi trocar o

Do While Range("A" & Linha).Value <> ""
Linha = Linha + 1
Loop[/codebox]

por:

[codebox]Do While Worksheets("Comissários").Range("A" & Linha).Value <> ""
Linha = Linha + 1
Loop

Valeu!

Link to comment
Share on other sites

  • 0

Sugiro trocar por:

Linha = Cells(Rows.Count, "A").End(xlUp).Row + 1
Fiz uma discussão sobre obter última linha por VBA em: http://www.ambienteoffice.com.br/excel/obt...e_um_intervalo/ Troque também:
Private Sub fem1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim strValid As String
    strValid = "0123456789"

    If InStr(strValid, Chr(KeyAscii)) = 0 Then
        KeyAscii = 0
    End If
End Sub


Private Sub fem2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim strValid As String
    strValid = "0123456789"

    If InStr(strValid, Chr(KeyAscii)) = 0 Then
        KeyAscii = 0
    End If
End Sub

Private Sub fem3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim strValid As String
    strValid = "0123456789"

    If InStr(strValid, Chr(KeyAscii)) = 0 Then
        KeyAscii = 0
    End If
End Sub

Private Sub masc1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim strValid As String
    strValid = "0123456789"

    If InStr(strValid, Chr(KeyAscii)) = 0 Then
        KeyAscii = 0
    End If

End Sub


Private Sub masc2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim strValid As String
    strValid = "0123456789"

    If InStr(strValid, Chr(KeyAscii)) = 0 Then
        KeyAscii = 0
    End If
End Sub


Private Sub masc3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim strValid As String
    strValid = "0123456789"

    If InStr(strValid, Chr(KeyAscii)) = 0 Then
        KeyAscii = 0
    End If
End Sub
por:
Private Sub fem1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = ValidarTecla(KeyAscii)
End Sub


Private Sub fem2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = ValidarTecla(KeyAscii)
End Sub

Private Sub fem3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = ValidarTecla(KeyAscii)
End Sub

Private Sub masc1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = ValidarTecla(KeyAscii)
End Sub


Private Sub masc2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = ValidarTecla(KeyAscii)
End Sub


Private Sub masc3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = ValidarTecla(KeyAscii)
End Sub

Private Function ValidarTecla(i As Integer) As Integer
    If InStr("0123456789", Chr(i)) = 0 Then
        MsgBox "Utilize apenas números!", vbCritical
        ValidarTecla = 0
    Else
        ValidarTecla = i
    End If
End Function

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share



  • Forum Statistics

    • Total Topics
      150.9k
    • Total Posts
      648.8k
×
×
  • Create New...