ModeloCadastrov3ListView [RESOLVIDO]

[lfrbranca]

Bom dia tenho a private sub abaixo.
Mas queria que aceitasse também letras sempre maiúsculas como por exemplo 5642-MD-55-1234 ou 5642-NI-55-1234
Alguém me pode dar uma ajuda

Private Sub txtNAPMD_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Limita a Qde de caracteres
txtNAPMD.MaxLength = 16


Select Case KeyAscii

Case 8, 48 To 57 ' BackSpace e numericos
If Len(txtNAPMD) = 4 Or Len(txtNAPMD) = 5 Then
txtNAPMD.Text = txtNAPMD.Text & "-"
SendKeys "{End}", False

ElseIf Len(txtNAPMD) = 7 Then
txtNAPMD.Text = txtNAPMD.Text & "-"

ElseIf Len(txtNAPMD) = 11 Then
txtNAPMD.Text = txtNAPMD.Text & "-"
SendKeys "{End}", False
End If

Case Else ' o resto é travado
KeyAscii = 0

End Select

End Sub



Obrigado

[Mikel Silveira Fraga]

LfrBranca, bom dia.

Cara, vi que você enviou uma dúvida no final de semana, mas não é sempre que entro pra responder o fórum nesse período.

Bem, vamos as dúvidas:

1ª DÚVIDA:

Sempre que coloco um novo registo ou actualizo da o erro abaixo isto porque tanto na txtNAPMD como na txtNNA deverá ser preenchido com um numero neste formato 1111-11-111-1111 ou 5620-MD-256-3521

No texto abaixo desse trecho informado, foi marcado apenas a linha em que esta ocorrendo o erro, mas o mesmo pode ter ocorrido por vários motivos. Deixe o anexo e a observação do tipo de erro que esta ocorrendo, para que possamos dar uma olhada.

2ª DÚVIDA:

Mas queria que aceitasse também letras sempre maiúsculas como por exemplo 5642-MD-55-1234 ou 5642-NI-55-1234

Estou um pouco na dúvida com a solicitação, mas acredito que seja apenas letras maiúsculas, certo? Se for isso, adicione ao código e comando UCase, conforme abaixo:

Código: Selecionar todos

Private Sub txtNAPMD_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Limita a Qde de caracteres
txtNAPMD.MaxLength = 16

txtNAPMD.Value = UCase(txtNAPMD.Value) ' Entre com esse código para forçar somente MAIÚSCULA.

Select Case KeyAscii

Bem teste o código da sua 2ª dúvida e veja se consegue dar mais detalhes sobre o erro da primeira.

Abraços e excelente semana.

[lfrbranca]

Queria que aceitasse também letras sempre maiúsculas como por exemplo 5642-MD-55-1234 ou 5642-NI-55-1234
Mas só aceita numeros com a private sub abaixo
Dá para alterar a private sub por forma a aceitar tambem as letras D, I, M e N mas que as letras fiquem sempre em maiusculas
segue o link para poder dar uma olhada

https://www.dropbox.com/s/3f6gpe4802jpx ... o.zip?dl=0


Private Sub txtNAPMD_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Limita a Qde de caracteres
txtNAPMD.MaxLength = 16


Select Case KeyAscii

Case 8, 48 To 57 ' BackSpace e numericos
If Len(txtNAPMD) = 4 Or Len(txtNAPMD) = 5 Then
txtNAPMD.Text = txtNAPMD.Text & "-"
SendKeys "{End}", False

ElseIf Len(txtNAPMD) = 7 Then
txtNAPMD.Text = txtNAPMD.Text & "-"

ElseIf Len(txtNAPMD) = 11 Then
txtNAPMD.Text = txtNAPMD.Text & "-"
SendKeys "{End}", False
End If

Case Else ' o resto é travado
KeyAscii = 0

End Select

End Sub

Obrigado

[Mikel Silveira Fraga]

LfrBranca, bom dia.

Entendi, não havia observado que era apenas números. Bem, nesse caso, altere todo o código pelo código abaixo:

Código: Selecionar todos

Private Sub txtNAPMD_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Limita a Qde de caracteres
txtNAPMD.MaxLength = 16

'A linha abaixo mantem as letras APENAS MAIÚSCULAS.
'txtNAPMD.Value = UCase(txtNAPMD.Value)

If Len(txtNAPMD) = 4 Or Len(txtNAPMD) = 5 Then
txtNAPMD.Text = txtNAPMD.Text & "-"
SendKeys "{End}", False

ElseIf Len(txtNAPMD) = 7 Then
txtNAPMD.Text = txtNAPMD.Text & "-"

ElseIf Len(txtNAPMD) = 11 Then
txtNAPMD.Text = txtNAPMD.Text & "-"
SendKeys "{End}", False
End If

End Sub

Veja se agora funciona.

[lfrbranca]

A

[lfrbranca]

LfrBranca, bom dia.

Entendi, não havia observado que era apenas números. Bem, nesse caso, altere todo o código pelo código abaixo:

Código: Selecionar todos

Private Sub txtNAPMD_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Limita a Qde de caracteres
txtNAPMD.MaxLength = 16

'A linha abaixo mantem as letras APENAS MAIÚSCULAS.
'txtNAPMD.Value = UCase(txtNAPMD.Value)

If Len(txtNAPMD) = 4 Or Len(txtNAPMD) = 5 Then
txtNAPMD.Text = txtNAPMD.Text & "-"
SendKeys "{End}", False

ElseIf Len(txtNAPMD) = 7 Then
txtNAPMD.Text = txtNAPMD.Text & "-"

ElseIf Len(txtNAPMD) = 11 Then
txtNAPMD.Text = txtNAPMD.Text & "-"
SendKeys "{End}", False
End If

End Sub

Veja se agora funciona.

Funcionou obrigado
Andei a pesquisar mas nao econtrei nenhum código para colocar automaticamente a data actual ao clicar na textbox mas apenas quando e para inserir um novo registo ou alterar registo.

Mais uma vez o meu muito obrigado por toda a sua ajuda

[Mikel Silveira Fraga]

LfrBranca, bom dia.

Não entendi ao certo a necessidade da data ser inserida apenas ao clicar no TextBox, mas esse controle não possui um evento Click, para iniciar a execução de uma rotina.

No caso, o que da pra se fazer, é utilizar um evento para Duplo Clique (DblClick). Veja se o código abaixo vai lhe ajudar:

Código: Selecionar todos

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Me.TextBox1.Value = VBA.Date
End Sub

Espero que esse código auxilie em seu problema.

Abraços.

[lfrbranca]

LfrBranca, bom dia.

Não entendi ao certo a necessidade da data ser inserida apenas ao clicar no TextBox, mas esse controle não possui um evento Click, para iniciar a execução de uma rotina.

No caso, o que da pra se fazer, é utilizar um evento para Duplo Clique (DblClick). Veja se o código abaixo vai lhe ajudar:

Código: Selecionar todos

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Me.TextBox1.Value = VBA.Date
End Sub

Espero que esse código auxilie em seu problema.

Abraços.

Coloquei o codigo acima mas ao efetuar alteração de um registo da este erro

Erro em tempo de execução '-2147352571 (800200005)':

Sub Alterar_Registro()
' If MsgBox("Confirma a Alteração de dados: " & Me.txtNomeEmpresa & "?", vbYesNo + vbQuestion, "ModeloCadastro") = vbNo Then
' Exit Sub
'End If
' , , , , , , , , ,,
With rstBanco
.Update Array("FIA", "COA", "DATA", "LSA", "NAPMD", "CORG", "NNA", "REF", "CATALOGADOR", "SIC", "LAU", "LDU", "TRDATA", "TRSIC", "TRLAU", "TRCATALOGADOR", "OBS", "ESTADO"), _
Array(txtFIA.Text, txtCOA.Text, txtDATA.Text, txtLSA.Text, txtNAPMD.Text, txtCORG.Text, txtNNA.Text, txtREF.Text, txtCATALOGADOR.Text, txtSIC.Text, txtLAU.Text, txtLDU.Text, txtTRDATA.Text, txtTRSIC.Text, txtTRLAU.Text, txtTRCATALOGADOR.Text, txtOBS.Text, txtESTADO.Text)
End With
rstBanco.Update
'MsgBox "Alterado com sucesso.", vbInformation, "ModeloCadastro"
End Sub

[lfrbranca]

LfrBranca, bom dia.

Não entendi ao certo a necessidade da data ser inserida apenas ao clicar no TextBox, mas esse controle não possui um evento Click, para iniciar a execução de uma rotina.

No caso, o que da pra se fazer, é utilizar um evento para Duplo Clique (DblClick). Veja se o código abaixo vai lhe ajudar:

Código: Selecionar todos

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Me.TextBox1.Value = VBA.Date
End Sub

Espero que esse código auxilie em seu problema.

Abraços.

Pode me ajudar no erro

Obrigado e boa semana

[Mikel Silveira Fraga]

LfrBranca, boa tarde.

Qual é o erro que esta ocorrendo?