Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Campo de busca não ...
 
Notifications
Clear all

Campo de busca não permite seleção de nome iguais

 
2024 - VBA & Macros
Post Recente por jrs 7 anos atrás
13 Posts
4 Usuários
0 Reactions
1,976 Visualizações
RSS
 jrs
(@jrs)
Posts: 21
Eminent Member
Topic starter
 

É o seguinte, eu tenho uma caixa de busca, onde ela não permite que eu selecione outros cadastro com o mesmo nome. Por exemplo, existe 5 cadastro com o mesmo nome, sempre que vou selecionar o ultimo, ele seleciona o 1 e puxa os dados do primeiro ao em vez de puxar o 5 cadastro, e fica nisso... mas se forem nomes diferente, funciona normal.

Minha caixa de busca:

Private Sub assbox_Change()
'CÓDIGO DE BUSCAR OS CADASTROS PELO NOME
addlines = Worksheets("Plan1").UsedRange.Rows.Count
assbox.RowSource = "Plan1!a2:a" & addlines

'O CODIGO ABAIXO É PARA TRAZER OS DEMAIS DADOS CADASTRADOS NOS CAMPOS
localdemon = Worksheets("Plan1").UsedRange.Rows.Count
For i = 0 To localdemon
If assbox.ListIndex = i Then
editnamebox = Cells(i + 2, 1)
editdiscbox = Cells(i + 2, 2)
datecad = Cells(i + 2, 3)
editassuntbox = Cells(i + 2, 4)
editnumbox = Cells(i + 2, 6)
Exit Sub
End If
Next
End Sub

 
Postado : 26/01/2018 7:57 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

jrs,

Bom dia!

Anexe, aqui mesmo no fórum, seu arquivo compactado com .ZIP.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 26/01/2018 8:32 am
 jrs
(@jrs)
Posts: 21
Eminent Member
Topic starter
 

jrs,

Bom dia!

Anexe, aqui mesmo no fórum, seu arquivo compactado com .ZIP.

Como solicitado, anexei o arquivo

 
Postado : 26/01/2018 8:51 am
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 

Teste o código abaixo:

 Private Sub assbox_Change()
Dim indice As Long
indice = assbox.ListIndex
addlines = Worksheets("Plan1").UsedRange.Rows.Count
assbox.RowSource = "Plan1!a2:a" & addlines

localedit.Text = assbox
localedit.Enabled = False

datecad.Enabled = False

editdiscbox.Enabled = False

editnumbox.Enabled = False

localdemon = Worksheets("Plan1").UsedRange.Rows.Count
For i = 0 To localdemon - 2
If indice = i Then
editnamebox = Cells(i + 2, 1)
editdiscbox = Cells(i + 2, 2)
datecad = Cells(i + 2, 3)
editassuntbox = Cells(i + 2, 4)
editnumbox = Cells(i + 2, 6)
Exit Sub
End If
Next

End Sub
Private Sub assbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub
Private Sub CommandButton2_Click()

Ultlinha = Plan1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Ultlinha
If Plan1.Cells(i, "A") = assbox.Value Then
Plan1.Cells(i, "B") = editdiscbox.Value
Plan1.Cells(i, "D") = editassuntbox.Value
MsgBox ("Informação registrada com sucesso.")
Exit For
End If
Next

Unload UserForm3
UserForm3.Show


End Sub
Private Sub CommandButton3_Click()
Unload UserForm3
UserForm1.Show
End Sub
Private Sub CommandButton4_Click()
Ultlinha = Plan1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Ultlinha
If Plan1.Cells(i, "A") = assbox.Value Then
Plan1.Cells(i, "A") = editnamebox.Value
MsgBox ("O nome foi alterado, agora salve o cadastro.")
Exit For
End If
Next
End Sub

Private Sub editassuntbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If Not IsNumeric(editassuntbox.Text) Then
     'método para gravação
Else
      MsgBox "Esse campo apenas permite o uso de letras."
      editassuntbox.Text = ""
      Exit Sub
End If
End Sub
Private Sub editdiscbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub

Private Sub editnamebox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If Not IsNumeric(editnamebox.Text) Then
     'método para gravação
Else
      MsgBox "Esse campo apenas permite o uso de letras."
      editnamebox.Text = ""
      Exit Sub
End If
End Sub
Private Sub UserForm_Initialize()
addlines = Worksheets("Plan1").UsedRange.Rows.Count
assbox.RowSource = "Plan1!a2:a" & addlines

assbox.SetFocus

editdiscbox.AddItem "APOSTILA - NRH"
editdiscbox.AddItem "APOSTILA - CRA/6"
editdiscbox.AddItem "FOLHA DE INFORMAÇÃO - NRH"
editdiscbox.AddItem "MEMORANDO - NRH"
editdiscbox.AddItem "OFÍCIO - NRH"
editdiscbox.AddItem "PORTARIAS - NRH"
editdiscbox.AddItem "PORTARIAS - CRA"
editdiscbox.AddItem "PORTARIAS - DRH"
editdiscbox.AddItem "PORTARIAS DA DIRETORIA DE DIVISÃO - (CRA/6-G)"
editdiscbox.AddItem "PORTARIAS - CGA"
editdiscbox.AddItem "PORTARIAS - CAF (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAF/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT (CRA/6) / CTG (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - GS-CH/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT/CAF (CRA/6)"
editdiscbox.AddItem "CERTIDÕES DIVERSAS"
editdiscbox.AddItem "CERTIDÃO 101"
editdiscbox.AddItem "CERTIDÃO 102"
editdiscbox.AddItem "RESOLUÇÃO S"
editdiscbox.AddItem "CERTIDÃO DE PRÊMIO DE PRODUTIVIDADE"
editdiscbox.AddItem "FORMULÁRIO DE DADOS"
editdiscbox.AddItem "PORTARIAS - CSTC"
editdiscbox.AddItem "PORTARIAS - CAT/CSTC"
editdiscbox.AddItem "PORTARIAS - CSTC/CAT"
editdiscbox.AddItem "PORTARIAS - DRT/7"
editdiscbox.AddItem "APOSTILAS - DRT/7"
editdiscbox.AddItem "PORTARIAS - CRDPe/6"
editdiscbox.AddItem "PORTARIAS - DDPE"
editdiscbox.AddItem "PORTARIAS - TIT"
editdiscbox.AddItem "PORTARIAS - DTJ/3"
editdiscbox.AddItem "PORTARIAS - DTJ/1"
editdiscbox.AddItem "PORTARIAS - RF/3"
editdiscbox.AddItem "PORTARIAS - DA e DI"
editdiscbox.AddItem "PORTARIAS - DRF e CAT"

End Sub
 
Postado : 26/01/2018 9:25 am
 jrs
(@jrs)
Posts: 21
Eminent Member
Topic starter
 

Teste o código abaixo:

 Private Sub assbox_Change()
Dim indice As Long
indice = assbox.ListIndex
addlines = Worksheets("Plan1").UsedRange.Rows.Count
assbox.RowSource = "Plan1!a2:a" & addlines

localedit.Text = assbox
localedit.Enabled = False

datecad.Enabled = False

editdiscbox.Enabled = False

editnumbox.Enabled = False

localdemon = Worksheets("Plan1").UsedRange.Rows.Count
For i = 0 To localdemon - 2
If indice = i Then
editnamebox = Cells(i + 2, 1)
editdiscbox = Cells(i + 2, 2)
datecad = Cells(i + 2, 3)
editassuntbox = Cells(i + 2, 4)
editnumbox = Cells(i + 2, 6)
Exit Sub
End If
Next

End Sub
Private Sub assbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub
Private Sub CommandButton2_Click()

Ultlinha = Plan1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Ultlinha
If Plan1.Cells(i, "A") = assbox.Value Then
Plan1.Cells(i, "B") = editdiscbox.Value
Plan1.Cells(i, "D") = editassuntbox.Value
MsgBox ("Informação registrada com sucesso.")
Exit For
End If
Next

Unload UserForm3
UserForm3.Show


End Sub
Private Sub CommandButton3_Click()
Unload UserForm3
UserForm1.Show
End Sub
Private Sub CommandButton4_Click()
Ultlinha = Plan1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Ultlinha
If Plan1.Cells(i, "A") = assbox.Value Then
Plan1.Cells(i, "A") = editnamebox.Value
MsgBox ("O nome foi alterado, agora salve o cadastro.")
Exit For
End If
Next
End Sub

Private Sub editassuntbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If Not IsNumeric(editassuntbox.Text) Then
     'método para gravação
Else
      MsgBox "Esse campo apenas permite o uso de letras."
      editassuntbox.Text = ""
      Exit Sub
End If
End Sub
Private Sub editdiscbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub

Private Sub editnamebox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If Not IsNumeric(editnamebox.Text) Then
     'método para gravação
Else
      MsgBox "Esse campo apenas permite o uso de letras."
      editnamebox.Text = ""
      Exit Sub
End If
End Sub
Private Sub UserForm_Initialize()
addlines = Worksheets("Plan1").UsedRange.Rows.Count
assbox.RowSource = "Plan1!a2:a" & addlines

assbox.SetFocus

editdiscbox.AddItem "APOSTILA - NRH"
editdiscbox.AddItem "APOSTILA - CRA/6"
editdiscbox.AddItem "FOLHA DE INFORMAÇÃO - NRH"
editdiscbox.AddItem "MEMORANDO - NRH"
editdiscbox.AddItem "OFÍCIO - NRH"
editdiscbox.AddItem "PORTARIAS - NRH"
editdiscbox.AddItem "PORTARIAS - CRA"
editdiscbox.AddItem "PORTARIAS - DRH"
editdiscbox.AddItem "PORTARIAS DA DIRETORIA DE DIVISÃO - (CRA/6-G)"
editdiscbox.AddItem "PORTARIAS - CGA"
editdiscbox.AddItem "PORTARIAS - CAF (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAF/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT (CRA/6) / CTG (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - GS-CH/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT/CAF (CRA/6)"
editdiscbox.AddItem "CERTIDÕES DIVERSAS"
editdiscbox.AddItem "CERTIDÃO 101"
editdiscbox.AddItem "CERTIDÃO 102"
editdiscbox.AddItem "RESOLUÇÃO S"
editdiscbox.AddItem "CERTIDÃO DE PRÊMIO DE PRODUTIVIDADE"
editdiscbox.AddItem "FORMULÁRIO DE DADOS"
editdiscbox.AddItem "PORTARIAS - CSTC"
editdiscbox.AddItem "PORTARIAS - CAT/CSTC"
editdiscbox.AddItem "PORTARIAS - CSTC/CAT"
editdiscbox.AddItem "PORTARIAS - DRT/7"
editdiscbox.AddItem "APOSTILAS - DRT/7"
editdiscbox.AddItem "PORTARIAS - CRDPe/6"
editdiscbox.AddItem "PORTARIAS - DDPE"
editdiscbox.AddItem "PORTARIAS - TIT"
editdiscbox.AddItem "PORTARIAS - DTJ/3"
editdiscbox.AddItem "PORTARIAS - DTJ/1"
editdiscbox.AddItem "PORTARIAS - RF/3"
editdiscbox.AddItem "PORTARIAS - DA e DI"
editdiscbox.AddItem "PORTARIAS - DRF e CAT"

End Sub

Cara, você é foda, deu certo, só uma duvida, tem jeito de limitar para aparecer apenas os 10 ultimos cadastrados?

 
Postado : 26/01/2018 11:12 am
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 

Correção do código abaixo

 
Postado : 26/01/2018 3:47 pm
 jrs
(@jrs)
Posts: 21
Eminent Member
Topic starter
 

Olá, ainda não mostra os 10 ultimos cadastro no menu editar, segue minha planilha.

 
Postado : 30/01/2018 6:43 am
 jrs
(@jrs)
Posts: 21
Eminent Member
Topic starter
 

Pega as 10 primeiras linhas:

Private Sub assbox_Change()
Dim indice As Long
indice = assbox.ListIndex
'addlines = Worksheets("Plan1").UsedRange.Rows.Count
'assbox.RowSource = "Plan1!a2:a" & addlines

localedit.Text = assbox
localedit.Enabled = False

datecad.Enabled = False

editdiscbox.Enabled = False

editnumbox.Enabled = False

localdemon = Worksheets("Plan1").UsedRange.Rows.Count
For i = 0 To localdemon - 2
If indice = i Then
editnamebox = Cells(i + 2, 1)
editdiscbox = Cells(i + 2, 2)
datecad = Cells(i + 2, 3)
editassuntbox = Cells(i + 2, 4)
editnumbox = Cells(i + 2, 6)
Exit Sub
End If
Next

End Sub
Private Sub assbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub
Private Sub CommandButton2_Click()

Ultlinha = Plan1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Ultlinha
If Plan1.Cells(i, "A") = assbox.Value Then
Plan1.Cells(i, "B") = editdiscbox.Value
Plan1.Cells(i, "D") = editassuntbox.Value
MsgBox ("Informação registrada com sucesso.")
Exit For
End If
Next

Unload UserForm3
UserForm3.Show


End Sub
Private Sub CommandButton3_Click()
Unload UserForm3
UserForm1.Show
End Sub
Private Sub CommandButton4_Click()
Ultlinha = Plan1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Ultlinha
If Plan1.Cells(i, "A") = assbox.Value Then
Plan1.Cells(i, "A") = editnamebox.Value
MsgBox ("O nome foi alterado, agora salve o cadastro.")
Exit For
End If
Next
End Sub

Private Sub editassuntbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If Not IsNumeric(editassuntbox.Text) Then
     'método para gravação
Else
      MsgBox "Esse campo apenas permite o uso de letras."
      editassuntbox.Text = ""
      Exit Sub
End If
End Sub
Private Sub editdiscbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub

Private Sub editnamebox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If Not IsNumeric(editnamebox.Text) Then
     'método para gravação
Else
      MsgBox "Esse campo apenas permite o uso de letras."
      editnamebox.Text = ""
      Exit Sub
End If
End Sub
Private Sub UserForm_Initialize()
addlines = Worksheets("Plan1").UsedRange.Rows.Count
If addlines <= 11 Then
assbox.RowSource = "Plan1!a2:a" & addlines

Else
assbox.RowSource = "Plan1!a2:a11"
End If

assbox.SetFocus

editdiscbox.AddItem "APOSTILA - NRH"
editdiscbox.AddItem "APOSTILA - CRA/6"
editdiscbox.AddItem "FOLHA DE INFORMAÇÃO - NRH"
editdiscbox.AddItem "MEMORANDO - NRH"
editdiscbox.AddItem "OFÍCIO - NRH"
editdiscbox.AddItem "PORTARIAS - NRH"
editdiscbox.AddItem "PORTARIAS - CRA"
editdiscbox.AddItem "PORTARIAS - DRH"
editdiscbox.AddItem "PORTARIAS DA DIRETORIA DE DIVISÃO - (CRA/6-G)"
editdiscbox.AddItem "PORTARIAS - CGA"
editdiscbox.AddItem "PORTARIAS - CAF (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAF/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT (CRA/6) / CTG (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - GS-CH/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT/CAF (CRA/6)"
editdiscbox.AddItem "CERTIDÕES DIVERSAS"
editdiscbox.AddItem "CERTIDÃO 101"
editdiscbox.AddItem "CERTIDÃO 102"
editdiscbox.AddItem "RESOLUÇÃO S"
editdiscbox.AddItem "CERTIDÃO DE PRÊMIO DE PRODUTIVIDADE"
editdiscbox.AddItem "FORMULÁRIO DE DADOS"
editdiscbox.AddItem "PORTARIAS - CSTC"
editdiscbox.AddItem "PORTARIAS - CAT/CSTC"
editdiscbox.AddItem "PORTARIAS - CSTC/CAT"
editdiscbox.AddItem "PORTARIAS - DRT/7"
editdiscbox.AddItem "APOSTILAS - DRT/7"
editdiscbox.AddItem "PORTARIAS - CRDPe/6"
editdiscbox.AddItem "PORTARIAS - DDPE"
editdiscbox.AddItem "PORTARIAS - TIT"
editdiscbox.AddItem "PORTARIAS - DTJ/3"
editdiscbox.AddItem "PORTARIAS - DTJ/1"
editdiscbox.AddItem "PORTARIAS - RF/3"
editdiscbox.AddItem "PORTARIAS - DA e DI"
editdiscbox.AddItem "PORTARIAS - DRF e CAT"

End Sub

Pega as 10 últimas linhas:

Private Sub assbox_Change()
Dim indice As Long
indice = assbox.ListIndex
'addlines = Worksheets("Plan1").UsedRange.Rows.Count
'assbox.RowSource = "Plan1!a2:a" & addlines

localedit.Text = assbox
localedit.Enabled = False

datecad.Enabled = False

editdiscbox.Enabled = False

editnumbox.Enabled = False

localdemon = Worksheets("Plan1").UsedRange.Rows.Count
For i = 0 To localdemon - 2
If indice = i Then
editnamebox = Cells(i + 2, 1)
editdiscbox = Cells(i + 2, 2)
datecad = Cells(i + 2, 3)
editassuntbox = Cells(i + 2, 4)
editnumbox = Cells(i + 2, 6)
Exit Sub
End If
Next

End Sub
Private Sub assbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub
Private Sub CommandButton2_Click()

Ultlinha = Plan1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Ultlinha
If Plan1.Cells(i, "A") = assbox.Value Then
Plan1.Cells(i, "B") = editdiscbox.Value
Plan1.Cells(i, "D") = editassuntbox.Value
MsgBox ("Informação registrada com sucesso.")
Exit For
End If
Next

Unload UserForm3
UserForm3.Show


End Sub
Private Sub CommandButton3_Click()
Unload UserForm3
UserForm1.Show
End Sub
Private Sub CommandButton4_Click()
Ultlinha = Plan1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Ultlinha
If Plan1.Cells(i, "A") = assbox.Value Then
Plan1.Cells(i, "A") = editnamebox.Value
MsgBox ("O nome foi alterado, agora salve o cadastro.")
Exit For
End If
Next
End Sub

Private Sub editassuntbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If Not IsNumeric(editassuntbox.Text) Then
     'método para gravação
Else
      MsgBox "Esse campo apenas permite o uso de letras."
      editassuntbox.Text = ""
      Exit Sub
End If
End Sub
Private Sub editdiscbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub

Private Sub editnamebox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If Not IsNumeric(editnamebox.Text) Then
     'método para gravação
Else
      MsgBox "Esse campo apenas permite o uso de letras."
      editnamebox.Text = ""
      Exit Sub
End If
End Sub
Private Sub UserForm_Initialize()
addlines = Worksheets("Plan1").UsedRange.Rows.Count
If addlines <= 11 Then
assbox.RowSource = "Plan1!a2:a" & addlines

Else

assbox.RowSource = "Plan1!a" & addlines - 10 & ":a" & addlines
End If

assbox.SetFocus

editdiscbox.AddItem "APOSTILA - NRH"
editdiscbox.AddItem "APOSTILA - CRA/6"
editdiscbox.AddItem "FOLHA DE INFORMAÇÃO - NRH"
editdiscbox.AddItem "MEMORANDO - NRH"
editdiscbox.AddItem "OFÍCIO - NRH"
editdiscbox.AddItem "PORTARIAS - NRH"
editdiscbox.AddItem "PORTARIAS - CRA"
editdiscbox.AddItem "PORTARIAS - DRH"
editdiscbox.AddItem "PORTARIAS DA DIRETORIA DE DIVISÃO - (CRA/6-G)"
editdiscbox.AddItem "PORTARIAS - CGA"
editdiscbox.AddItem "PORTARIAS - CAF (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAF/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT (CRA/6) / CTG (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - GS-CH/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT/CAF (CRA/6)"
editdiscbox.AddItem "CERTIDÕES DIVERSAS"
editdiscbox.AddItem "CERTIDÃO 101"
editdiscbox.AddItem "CERTIDÃO 102"
editdiscbox.AddItem "RESOLUÇÃO S"
editdiscbox.AddItem "CERTIDÃO DE PRÊMIO DE PRODUTIVIDADE"
editdiscbox.AddItem "FORMULÁRIO DE DADOS"
editdiscbox.AddItem "PORTARIAS - CSTC"
editdiscbox.AddItem "PORTARIAS - CAT/CSTC"
editdiscbox.AddItem "PORTARIAS - CSTC/CAT"
editdiscbox.AddItem "PORTARIAS - DRT/7"
editdiscbox.AddItem "APOSTILAS - DRT/7"
editdiscbox.AddItem "PORTARIAS - CRDPe/6"
editdiscbox.AddItem "PORTARIAS - DDPE"
editdiscbox.AddItem "PORTARIAS - TIT"
editdiscbox.AddItem "PORTARIAS - DTJ/3"
editdiscbox.AddItem "PORTARIAS - DTJ/1"
editdiscbox.AddItem "PORTARIAS - RF/3"
editdiscbox.AddItem "PORTARIAS - DA e DI"
editdiscbox.AddItem "PORTARIAS - DRF e CAT"

End Sub

Deu algum problema, não mostra ainda os 10 ultimos

 
Postado : 31/01/2018 6:46 am
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 
Private Sub assbox_Change()
Dim indice As Long
indice = assbox.ListIndex
'addlines = Worksheets("Plan1").UsedRange.Rows.Count
'assbox.RowSource = "Plan1!a2:a" & addlines

localedit.Text = assbox
localedit.Enabled = False

datecad.Enabled = False

editdiscbox.Enabled = False

editnumbox.Enabled = False

localdemon = Worksheets("Plan1").UsedRange.Rows.Count
For i = 0 To localdemon - 2
If indice = i Then
editnamebox = Cells(i + 2, 1)
editdiscbox = Cells(i + 2, 2)
datecad = Cells(i + 2, 3)
editassuntbox = Cells(i + 2, 4)
editnumbox = Cells(i + 2, 6)
Exit Sub
End If
Next

End Sub
Private Sub assbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub
Private Sub CommandButton2_Click()

Ultlinha = Plan1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Ultlinha
If Plan1.Cells(i, "A") = assbox.Value Then
Plan1.Cells(i, "B") = editdiscbox.Value
Plan1.Cells(i, "D") = editassuntbox.Value
MsgBox ("Informação registrada com sucesso.")
Exit For
End If
Next

Unload UserForm3
UserForm3.Show


End Sub
Private Sub CommandButton3_Click()
Unload UserForm3
UserForm1.Show
End Sub
Private Sub CommandButton4_Click()
Ultlinha = Plan1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Ultlinha
If Plan1.Cells(i, "A") = assbox.Value Then
Plan1.Cells(i, "A") = editnamebox.Value
MsgBox ("O nome foi alterado, agora salve o cadastro.")
Exit For
End If
Next
End Sub

Private Sub editassuntbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If Not IsNumeric(editassuntbox.Text) Then
     'método para gravação
Else
      MsgBox "Esse campo apenas permite o uso de letras."
      editassuntbox.Text = ""
      Exit Sub
End If
End Sub
Private Sub editdiscbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub

Private Sub editnamebox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If Not IsNumeric(editnamebox.Text) Then
     'método para gravação
Else
      MsgBox "Esse campo apenas permite o uso de letras."
      editnamebox.Text = ""
      Exit Sub
End If
End Sub
Private Sub UserForm_Initialize()
addlines = Worksheets("Plan1").UsedRange.Rows.Count
If addlines <= 11 Then
assbox.RowSource = "Plan1!a2:a" & addlines

Else

assbox.RowSource = "Plan1!a" & addlines - 9 & ":a" & addlines
End If

assbox.SetFocus

editdiscbox.AddItem "APOSTILA - NRH"
editdiscbox.AddItem "APOSTILA - CRA/6"
editdiscbox.AddItem "FOLHA DE INFORMAÇÃO - NRH"
editdiscbox.AddItem "MEMORANDO - NRH"
editdiscbox.AddItem "OFÍCIO - NRH"
editdiscbox.AddItem "PORTARIAS - NRH"
editdiscbox.AddItem "PORTARIAS - CRA"
editdiscbox.AddItem "PORTARIAS - DRH"
editdiscbox.AddItem "PORTARIAS DA DIRETORIA DE DIVISÃO - (CRA/6-G)"
editdiscbox.AddItem "PORTARIAS - CGA"
editdiscbox.AddItem "PORTARIAS - CAF (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAF/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT (CRA/6) / CTG (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - GS-CH/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT/CAF (CRA/6)"
editdiscbox.AddItem "CERTIDÕES DIVERSAS"
editdiscbox.AddItem "CERTIDÃO 101"
editdiscbox.AddItem "CERTIDÃO 102"
editdiscbox.AddItem "RESOLUÇÃO S"
editdiscbox.AddItem "CERTIDÃO DE PRÊMIO DE PRODUTIVIDADE"
editdiscbox.AddItem "FORMULÁRIO DE DADOS"
editdiscbox.AddItem "PORTARIAS - CSTC"
editdiscbox.AddItem "PORTARIAS - CAT/CSTC"
editdiscbox.AddItem "PORTARIAS - CSTC/CAT"
editdiscbox.AddItem "PORTARIAS - DRT/7"
editdiscbox.AddItem "APOSTILAS - DRT/7"
editdiscbox.AddItem "PORTARIAS - CRDPe/6"
editdiscbox.AddItem "PORTARIAS - DDPE"
editdiscbox.AddItem "PORTARIAS - TIT"
editdiscbox.AddItem "PORTARIAS - DTJ/3"
editdiscbox.AddItem "PORTARIAS - DTJ/1"
editdiscbox.AddItem "PORTARIAS - RF/3"
editdiscbox.AddItem "PORTARIAS - DA e DI"
editdiscbox.AddItem "PORTARIAS - DRF e CAT"

End Sub
 
Postado : 31/01/2018 5:25 pm
 jrs
(@jrs)
Posts: 21
Eminent Member
Topic starter
 
Private Sub assbox_Change()

Klarc, me desculpe persistir nesse erro, mas entendi a razão do problema, agora esta ok, mostra os 10 ultimos cadastro, porém no meu campo de numeração, mostra o numero errado.

Quando seleciono por exemplo, um cadastro que tem uma numeração, ao puxar os dados, ele puxa com a numeração errada, note que estou selecionando abaixo o usuário "Juliano Renan Silverio", que a numeração cadastrada dele foi 6, só que no form, aparece 1.

Anexei os arquivos e a imagem

 
Postado : 01/02/2018 5:59 am
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 
Private Sub assbox_Change()
Dim indice As Long
indice = assbox.ListIndex
'addlines = Worksheets("Plan1").UsedRange.Rows.Count
'assbox.RowSource = "Plan1!a2:a" & addlines

localedit.Text = assbox
localedit.Enabled = False

datecad.Enabled = False

editdiscbox.Enabled = False

editnumbox.Enabled = False

localdemon = Worksheets("Plan1").UsedRange.Rows.Count
If tipo = True Then

For i = 0 To localdemon - 2
If indice = i Then
editnamebox = Plan1.Cells(i + 2, 1)
editdiscbox = Plan1.Cells(i + 2, 2)
datecad = Plan1.Cells(i + 2, 3)
editassuntbox = Plan1.Cells(i + 2, 4)
editnumbox = Plan1.Cells(i + 2, 6)
Exit Sub
End If
Next
End If



If tipo = False Then
Dim index As Integer
index = -1
For i = 9 To 0 Step -1
index = index + 1
If indice = i Then

editnamebox = Plan1.Cells(localdemon - index, 1)
editdiscbox = Plan1.Cells(localdemon - index, 2)
datecad = Plan1.Cells(localdemon - index, 3)
editassuntbox = Plan1.Cells(localdemon - index, 4)
editnumbox = Plan1.Cells(localdemon - index, 6)
Exit Sub
End If
Next i

End If




End Sub
Private Sub assbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub
Private Sub CommandButton2_Click()

Ultlinha = Plan1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Ultlinha
If Plan1.Cells(i, "A") = assbox.Value Then
Plan1.Cells(i, "B") = editdiscbox.Value
Plan1.Cells(i, "D") = editassuntbox.Value
MsgBox ("Informação registrada com sucesso.")
Exit For
End If
Next

Unload UserForm3
UserForm3.Show


End Sub
Private Sub CommandButton3_Click()
Unload UserForm3
UserForm1.Show
End Sub
Private Sub CommandButton4_Click()
Ultlinha = Plan1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Ultlinha
If Plan1.Cells(i, "A") = assbox.Value Then
Plan1.Cells(i, "A") = editnamebox.Value
MsgBox ("O nome foi alterado, agora salve o cadastro.")
Exit For
End If
Next
End Sub

Private Sub editassuntbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If Not IsNumeric(editassuntbox.Text) Then
     'método para gravação
Else
      MsgBox "Esse campo apenas permite o uso de letras."
      editassuntbox.Text = ""
      Exit Sub
End If
End Sub
Private Sub editdiscbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub

Private Sub editnamebox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If Not IsNumeric(editnamebox.Text) Then
     'método para gravação
Else
      MsgBox "Esse campo apenas permite o uso de letras."
      editnamebox.Text = ""
      Exit Sub
End If
End Sub
Private Sub UserForm_Initialize()

addlines = Worksheets("Plan1").UsedRange.Rows.Count
If addlines <= 11 Then
assbox.RowSource = "Plan1!a2:a" & addlines
tipo = True
Else
tipo = False
assbox.RowSource = "Plan1!a" & addlines - 9 & ":a" & addlines
End If

assbox.SetFocus

editdiscbox.AddItem "APOSTILA - NRH"
editdiscbox.AddItem "APOSTILA - CRA/6"
editdiscbox.AddItem "FOLHA DE INFORMAÇÃO - NRH"
editdiscbox.AddItem "MEMORANDO - NRH"
editdiscbox.AddItem "OFÍCIO - NRH"
editdiscbox.AddItem "PORTARIAS - NRH"
editdiscbox.AddItem "PORTARIAS - CRA"
editdiscbox.AddItem "PORTARIAS - DRH"
editdiscbox.AddItem "PORTARIAS DA DIRETORIA DE DIVISÃO - (CRA/6-G)"
editdiscbox.AddItem "PORTARIAS - CGA"
editdiscbox.AddItem "PORTARIAS - CAF (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAF/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT (CRA/6) / CTG (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - GS-CH/CGA (CRA/6)"
editdiscbox.AddItem "PORTARIAS - CAT/CAF (CRA/6)"
editdiscbox.AddItem "CERTIDÕES DIVERSAS"
editdiscbox.AddItem "CERTIDÃO 101"
editdiscbox.AddItem "CERTIDÃO 102"
editdiscbox.AddItem "RESOLUÇÃO S"
editdiscbox.AddItem "CERTIDÃO DE PRÊMIO DE PRODUTIVIDADE"
editdiscbox.AddItem "FORMULÁRIO DE DADOS"
editdiscbox.AddItem "PORTARIAS - CSTC"
editdiscbox.AddItem "PORTARIAS - CAT/CSTC"
editdiscbox.AddItem "PORTARIAS - CSTC/CAT"
editdiscbox.AddItem "PORTARIAS - DRT/7"
editdiscbox.AddItem "APOSTILAS - DRT/7"
editdiscbox.AddItem "PORTARIAS - CRDPe/6"
editdiscbox.AddItem "PORTARIAS - DDPE"
editdiscbox.AddItem "PORTARIAS - TIT"
editdiscbox.AddItem "PORTARIAS - DTJ/3"
editdiscbox.AddItem "PORTARIAS - DTJ/1"
editdiscbox.AddItem "PORTARIAS - RF/3"
editdiscbox.AddItem "PORTARIAS - DA e DI"
editdiscbox.AddItem "PORTARIAS - DRF e CAT"

End Sub
 
Postado : 01/02/2018 6:57 am
fcarlosc
 fcarlosc
(@fcarlosc)
Posts: 453
Honorable Member
 

Bom-dia

Seria dessa forma?

 
Postado : 01/02/2018 7:01 am
 jrs
(@jrs)
Posts: 21
Eminent Member
Topic starter
 

Bom-dia

Seria dessa forma?

Era do jeito do Klarc, mas obrigado, deu tudo certo, te dei joinha pelo apoio tb

 
Postado : 01/02/2018 9:12 am
Forum Jump:
  Tópico Anterior
Próximo Tópico