Olá colegas,
Estou com um problema que, pelo que vi, é muito comum e fácil de resolver. A questão é que não sei aplicar a solução, pois escrevi o código vba dessa tabela há muito tempo e não me lembro mais como faz...
Enfim, a questão é que tenho uma tabela na qual criei um formulário onde o usuário coloca uma série de dados e depois clica em inserir dados. Os dados digitados são transportados para a tabela do excel. Até aí tudo bem. O problema é que há 5 campos com datas, e no momento do transporte da data digitada para a planilha, a data vai invertida com formato americano.
Vi em alguns tópicos que a solução seria usar a função date.value, o problema é que não sei aplicar isso no meu código. Será que alguém pode me ajudar? Vou colar o código aqui, que alias, deve estar cheio de coisa inútil por conta da inexperência
Agradeço desde já!
Private Sub bcoCarregardata_Click()
cxtData.Text = Format(Date, "mm/dd/yyyy")
End Sub
Private Sub bcoInserirDados_Click()
MsgBox "Dados cadastrados com sucesso", vbExclamation, "Aviso"
ActiveCell.Offset(0, 0).Activate
ActiveCell.Value = Me.cxtData.Text
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = Me.cxtNome.Text
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = Me.cxtNºdoProcesso.Text
ActiveCell.Offset(0, 3).Activate
ActiveCell.Value = Me.cxtDatadenascimento.Text
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = Me.cboGenero.Text
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = Me.cboLocaldeResidencia.Text
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = Me.cboEscolaridade.Text
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = Me.cboUsadrogas.Text
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = Me.cboAto1.Text
ActiveCell.Offset(0, 2).Activate
ActiveCell.Value = Me.cboConcurso.Text
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = Me.cboArma.Text
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = Me.cboViolencia.Text
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = Me.cxtDataInternação.Text
ActiveCell.Offset(0, 2).Activate
ActiveCell.Value = Me.cboOrigem.Text
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = Me.cxtDataLiberação.Text
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = Me.cboLiberação.Text
ActiveCell.Offset(0, 2).Activate
ActiveCell.Value = Me.cxtDataSentença.Text
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = Me.cboJuizSentença.Text
ActiveCell.Offset(0, 2).Activate
ActiveCell.Value = Me.cboRemissão.Text
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = Me.cboSentença.Text
ActiveCell.Offset(1, -25).Activate
End Sub
Private Sub bcoLimparFormulario_Click()
cxtData.Text = ""
cxtNome.Text = ""
cxtNºdoProcesso.Text = ""
cxtDatadenascimento.Text = ""
cboGenero.Text = ""
cboLocaldeResidencia.Text = ""
cboEscolaridade.Text = ""
cboUsadrogas.Text = ""
cboAto1.Text = ""
cboConcurso.Text = ""
cboArma.Text = ""
cboViolencia.Text = ""
cxtDataInternação.Text = ""
cboOrigem.Text = ""
cxtDataLiberação.Text = ""
cboLiberação.Text = ""
cxtDataSentença.Text = ""
cboJuizSentença.Text = ""
cboRemissão.Text = ""
cboSentença.Text = ""
End Sub
Private Sub bcoFecharFormulario_Click()
Unload Me
End Sub
Private Sub cboAto1_Change()
End Sub
Private Sub cboLiberação_Change()
End Sub
Private Sub cxtData_Change()
If Len(cxtData) = 2 Or Len(cxtData) = 5 Then
cxtData.Text = cxtData.Text & "/"
SendKeys "{End}", True
End If
End Sub
Private Sub cxtDatadenascimento_Change()
If Len(cxtDatadenascimento) = 2 Or Len(cxtDatadenascimento) = 5 Then
cxtDatadenascimento.Text = cxtDatadenascimento.Text & "/"
SendKeys "{End}", True
End If
End Sub
Private Sub cxtDataInternação_Change()
If Len(cxtDataInternação) = 2 Or Len(cxtDataInternação) = 5 Then
cxtDataInternação.Text = cxtDataInternação.Text & "/"
SendKeys "{End}", True
End If
End Sub
Private Sub cxtDataLiberação_Change()
If Len(cxtDataLiberação) = 2 Or Len(cxtDataLiberação) = 5 Then
cxtDataLiberação.Text = cxtDataLiberação.Text & "/"
SendKeys "{End}", True
End If
End Sub
Private Sub cxtDataSentença_Change()
If Len(cxtDataSentença) = 2 Or Len(cxtDataSentença) = 5 Then
cxtDataSentença.Text = cxtDataSentença.Text & "/"
SendKeys "{End}", True
End If
End Sub
Private Sub cxtNome_Change()
End Sub
Private Sub Frame1_Click()
End Sub
Private Sub Label1_Click()
End Sub
Private Sub Label13_Click()
End Sub
Private Sub quaDadosdoProcesso_Click()
End Sub
Private Sub rotResultadodademanda_Click()
End Sub
Private Sub rotUsadrogas_Click()
End Sub
Postado : 12/07/2016 11:58 am