Notifications
Clear all

DATA INVERTIDA - VBA

10 Posts
2 Usuários
0 Reactions
1,251 Visualizações
(@camis1)
Posts: 6
Active Member
Topic starter
 

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 :D :oops:

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
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

camis1,

Boa tarde!

Onde tiver código que leva do formulário para a planilha uma data, use a função CDate antes para transformar o valor em data. Por Exemplo, na linha abaixo:

ActiveCell.Value = Me.cxtData.Text

Mude para:

ActiveCell.Value = CDate(Me.cxtData.Text)

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 : 12/07/2016 12:33 pm
(@camis1)
Posts: 6
Active Member
Topic starter
 

Oi Wagner, boa tarde!
Te agradeço pela rapidez e atenção.
Num primeiro momento, funcionou!!! Daí salvei e entrei de novo. Mas aí, ao clicar no botão do formulário para incluir os dados, apareceu um erro: "Erro em Tempo de Execução: '13': tipos incompatíveis" e quando coloco para depurar ele aponta exatamente para a linha onde coloquei o CDate.
E agora? :roll:

 
Postado : 12/07/2016 1:16 pm
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

camis1,

Bom... assim, à distância é um pouco complicado. Faça o seguinte: anexe seu arquivo aqui mesmo no fórum, compactado. Pode colocar dados fictícios se quiser, porém com o layout real dos seus dados.

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 : 12/07/2016 1:19 pm
(@camis1)
Posts: 6
Active Member
Topic starter
 

Oi, Wagner, segue o arquivo como solicitado. te agradeço mais uma vez!

 
Postado : 12/07/2016 1:49 pm
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

camis1,

Bom dia!

Fiz as alterações necessárias aqui e executei a inserção. Veja na planilha que fiz o teste de inserção apenas de datas. Você tem 5 caixas de texto para inserir datas. Inseri as 3 primeiras como 12/10/1958 e as duas últimas como 12/01/1958. Inseriu tudo corretamente e não deu nenhuma mensagem de erro.

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 : 13/07/2016 8:14 am
(@camis1)
Posts: 6
Active Member
Topic starter
 

Vou conferir aqui. De qualquer forma te agradeço!

 
Postado : 13/07/2016 11:00 am
(@camis1)
Posts: 6
Active Member
Topic starter
 

Acho que eu entendi quando ocorre o problema.
Usei o arquivo que você mandou e preenchi os 5 campos de data e funcionou perfeitamente.
Contudo, quando preencho apenas um, ou dois, ou três, enfim, quando não preencho todos os campos de data, a tela de erro aparece.
E, na rotina real de preenchimento da tabela, sempre ficará faltando um dos campos de data que será preenchido depois.
Será que há algo ainda que possa ser feito para o problema não se repetir?
Seguem as telas com o erro.
Obrigada!

 
Postado : 13/07/2016 11:17 am
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

camis1,

Sim, há! Basta colocar um IF para verificar se a caixa de texto foi preenchida. O Erro TIPOS INCOMPATÌVEIS é porque o VBA não reconhece o valor " " (vazio) como uma data. No modelo anexo, já não ocorre mais o erro.

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 : 13/07/2016 11:35 am
(@camis1)
Posts: 6
Active Member
Topic starter
 

Wagner, te agradeço muito pelo tempo e pela ajuda!
Consegui resolver esse problema final. Achei em outro fórum alguém com o problema parecido e achei a função para usar, veja:

ActiveCell.Offset(0, 13).Value = txtgerentecoordenador.Value

If txtdata2.Value <>"" Then
'Este comando somente será executado se o campo txtdata2 estiver preenchido.
ActiveCell.Offset(0, 14).Value = CDate(txtdata2.Value)
End If

ActiveCell.Offset(0, 15).Value = txtretrabalho.Value

Agora está perfeito.
Obrigada!

 
Postado : 13/07/2016 11:40 am