Problema com Data e Valor

[Ronaldo73]

Estou tentando elaborar uma planilha personalizada para trabalhar com VB.

Bom gente vou logo informar que esses código não foi eu minha autoria, foi pesquisando que encontrei.

Eu só alterei algumas propriedade para poder gerar o meu projeto, mas tá difícil.

minha dificudade esta sendo quando clico no botão de comando btnOk para salvar (ThisWorkbook.Worksheets("Entrada")

Os dados do formulário estão indo para a planilha com data invertida po ex:

o Correto seria assim 08/02/2010.

mas gera 02/08/2010 na célua "b2"

e também o valor de quantidades transportada esta indo com texto e o auto soma fica sempre zero (0).

já tentei dois código, mas acho que eu não estou sabendo em qual das rotina colocar, por isso que coloquei os código abaixo.

1º Me. txtData.Value = Format (Plan2.Range("b2").Value, "dd/mm/aaaa")

2º Range("b2").Value = CDate (txtData.Text)

'Código: Tomás Vásquez
'http://www.tomasvasquez.com.br
'http://tomas.vasquez.blog.uol.com.br

Option Explicit

Const colRegistro As Integer = 1
Const colData As Integer = 2
Const colUsinagem As Integer = 3
Const colMaterialUsinado As Integer = 4
Const colTipoDeMaterial As Integer = 5
Const colAsfaltoUtilizado As Integer = 6
Const colTicket As Integer = 7
Const colQuantidade As Integer = 8
Const colAplicação As Integer = 9
Const colObservação As Integer = 10
Const indiceMinimo As Byte = 2
Const corDisabledTextBox As Long = -2147483633
Const corEnabledTextBox As Long = -2147483643

Private wsCadastro As Worksheet
Private indiceRegistro As Long

Private Sub btnCancelar_Click()
    btnOK.Enabled = False
    btnCancelar.Enabled = False
    Call DesabilitaControles
    Call CarregaDadosInicial
    Call HabilitaBotoesAlteracao
End Sub

Private Sub btnOK_Click()
    Dim proximoId As Long

    'Altera
    If optAlterar.Value Then
        Call SalvaRegistro(CLng(txtReg.Text), indiceRegistro)
        lblMensagem.Caption = "Registro salvo com sucesso"
    End If
    'Novo
    If optNovo.Value Then
        proximoId = PegaProximoId
        'pega a próxima linha
        Dim proximoIndice As Long
        proximoIndice = wsCadastro.UsedRange.Rows.Count + 1
        Call SalvaRegistro(proximoId, proximoIndice)
        txtReg = proximoId
        lblMensagem.Caption = "Registro salvo com sucesso"
    End If
    'Excluir
    If optExcluir.Value Then
        Dim result As VbMsgBoxResult
        result = MsgBox("Deseja excluir o registro nº " & txtReg.Text & " ?", vbYesNo, "Confirmação")

        If result = vbYes Then
            wsCadastro.Range(wsCadastro.Cells(indiceRegistro, colRegistro), wsCadastro.Cells(indiceRegistro, colRegistro)).EntireRow.Delete
            Call CarregaDadosInicial
            lblMensagem.Caption = "Registro excluído com sucesso"
        End If
    End If

    Call HabilitaBotoesAlteracao
    Call DesabilitaControles

End Sub


Private Sub btnPesquisar_Click()
    frmPesquisa.Show
End Sub

Private Sub btnSair_Click()
    Unload Me
End Sub

Private Sub optAlterar_Click()
    If txtReg.Text <> vbNullString And txtReg.Text <> "" Then
        Call HabilitaControles
        Call DesabilitaBotoesAlteracao
        'dá o foco ao primeiro controle de dados
        txtData.SetFocus
    Else
        lblMensagem.Caption = "Não há registro a ser alterado"
    End If
End Sub

Private Sub optExcluir_Click()
    If txtReg.Text <> vbNullString And txtReg.Text <> "" Then
        Call DesabilitaBotoesAlteracao
        lblMensagem.Caption = "Modo de exclusão. Confira o dados do registro antes de excluí-lo"
    Else
        lblMensagem.Caption = "Não há registro a ser excluído"
    End If
End Sub

Private Sub optNovo_Click()
    Call LimpaControles
    Call HabilitaControles
    Call DesabilitaBotoesAlteracao
    'dá o foco ao primeiro controle de dados
    txtData.SetFocus
End Sub

Private Sub UserForm_Initialize()
    Set wsCadastro = ThisWorkbook.Worksheets("Entrada")
    Call HabilitaBotoesAlteracao
    Call CarregaDadosInicial
    Call DesabilitaControles
    End Sub

Private Sub btnAnterior_Click()
    If indiceRegistro > indiceMinimo Then
        indiceRegistro = indiceRegistro - 1
    End If
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub btnPrimeiro_Click()
    indiceRegistro = indiceMinimo
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub btnProximo_Click()
    If indiceRegistro < wsCadastro.UsedRange.Rows.Count Then
        indiceRegistro = indiceRegistro + 1
    End If
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub btnUltimo_Click()
    indiceRegistro = wsCadastro.UsedRange.Rows.Count
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub CarregaDadosInicial()
    indiceRegistro = 2
    Call CarregaRegistro
End Sub

Private Sub CarregaRegistro()
'carrega os dados do primeiro registro
    With wsCadastro
        If Not IsEmpty(.Cells(indiceRegistro, colTicket)) Then
            Me.txtReg.Text = .Cells(indiceRegistro, colRegistro).Value
            Me.txtData.Text = .Cells(indiceRegistro, colData).Value
            Me.cboUsina.Text = .Cells(indiceRegistro, colUsinagem).Value
            Me.cboMatUsinado.Text = .Cells(indiceRegistro, colMaterialUsinado).Value
            Me.cboTipoMaterial.Text = .Cells(indiceRegistro, colTipoDeMaterial).Value
            Me.cboAsfaltoUtilizado.Text = .Cells(indiceRegistro, colAsfaltoUtilizado).Value
            Me.txtTicket.Text = .Cells(indiceRegistro, colTicket).Value
            Me.txtQuantidade.Text = .Cells(indiceRegistro, colQuantidade).Value
            Me.cboAplicEquipe.Text = .Cells(indiceRegistro, colAplicação).Value
            Me.txtObs.Text = .Cells(indiceRegistro, colObservação).Value
        End If
    End With

    Call AtualizaRegistroCorrente
End Sub

Public Sub CarregaRegistroPorIndice(ByVal indice As Long)
'carrega os dados do registro baseado no índice
    indiceRegistro = indice

    Call CarregaRegistro
End Sub

Private Sub SalvaRegistro(ByVal id As Long, ByVal indice As Long)
    With wsCadastro
        .Cells(indice, colRegistro).Value = id
        .Cells(indice, colData).Value = Me.txtData.Text
        .Cells(indice, colUsinagem).Value = Me.cboUsina.Text
        .Cells(indice, colMaterialUsinado).Value = Me.cboMatUsinado.Text
        .Cells(indice, colTipoDeMaterial).Value = Me.cboTipoMaterial.Text
        .Cells(indice, colAsfaltoUtilizado).Value = Me.cboAsfaltoUtilizado.Text
        .Cells(indice, colTicket).Value = Me.txtTicket.Text
        .Cells(indice, colQuantidade).Value = Me.txtQuantidade.Text
        .Cells(indice, colAplicação).Value = Me.cboAplicEquipe.Text
        .Cells(indice, colObservação).Value = Me.txtObs.Text
    End With

    Call AtualizaRegistroCorrente
End Sub

Private Function PegaProximoId() As Long
    Dim rangeIds As Range
    'pega o range que se refere a toda a coluna do código (id)
    Set rangeIds = wsCadastro.Range(wsCadastro.Cells(indiceMinimo, colRegistro), wsCadastro.Cells(wsCadastro.UsedRange.Rows.Count, colRegistro))
    PegaProximoId = WorksheetFunction.Max(rangeIds) + 1
End Function

Private Sub AtualizaRegistroCorrente()
    lblNavigator.Caption = indiceRegistro - 1 & " de " & wsCadastro.UsedRange.Rows.Count - 1
    lblMensagem.Caption = ""
End Sub

Private Sub LimpaControles()
    Me.txtReg.Text = ""
    Me.txtData.Text = ""
    Me.cboUsina.Text = ""
    Me.cboMatUsinado.Text = ""
    Me.cboTipoMaterial.Text = ""
    Me.cboAsfaltoUtilizado.Text = ""
    Me.txtTicket.Text = ""
    Me.txtQuantidade.Text = ""
    Me.cboAplicEquipe.Text = ""
    Me.txtObs.Text = ""
End Sub

Private Sub HabilitaControles()
'Me.txtReg.Locked = False
    Me.txtData.Locked = False
    Me.cboUsina.Locked = False
    Me.cboMatUsinado.Locked = False
    Me.cboTipoMaterial.Locked = False
    Me.cboAsfaltoUtilizado.Locked = False
    Me.txtTicket.Locked = False
    Me.txtQuantidade.Locked = False
    Me.cboAplicEquipe.Locked = False
    Me.txtObs.Locked = False
    
    Me.txtData.BackColor = corEnabledTextBox
    Me.cboUsina.BackColor = corEnabledTextBox
    Me.cboMatUsinado.BackColor = corEnabledTextBox
    Me.cboTipoMaterial.BackColor = corEnabledTextBox
    Me.cboAsfaltoUtilizado.BackColor = corEnabledTextBox
    Me.txtTicket.BackColor = corEnabledTextBox
    Me.txtQuantidade.BackColor = corEnabledTextBox
    Me.cboAplicEquipe.BackColor = corEnabledTextBox
    Me.txtObs.BackColor = corEnabledTextBox
End Sub

Private Sub DesabilitaControles()
'Me.txtReg.Locked = True
    Me.txtData.Locked = True
    Me.cboUsina.Locked = True
    Me.cboMatUsinado.Locked = True
    Me.cboTipoMaterial.Locked = True
    Me.cboAsfaltoUtilizado.Locked = True
    Me.txtTicket.Locked = True
    Me.txtQuantidade.Locked = True
    Me.cboAplicEquipe.Locked = True
    Me.txtObs.Locked = True
    
    Me.txtData.BackColor = corDisabledTextBox
    Me.cboUsina.BackColor = corDisabledTextBox
    Me.cboMatUsinado.BackColor = corDisabledTextBox
    Me.cboTipoMaterial.BackColor = corDisabledTextBox
    Me.cboAsfaltoUtilizado.BackColor = corDisabledTextBox
    Me.txtTicket.BackColor = corDisabledTextBox
    Me.txtQuantidade.BackColor = corDisabledTextBox
    Me.cboAplicEquipe.BackColor = corDisabledTextBox
    Me.txtObs.BackColor = corDisabledTextBox
End Sub

Private Sub HabilitaBotoesAlteracao()
'habilita os botões de alteração
    optAlterar.Enabled = True
    optExcluir.Enabled = True
    optNovo.Enabled = True
    btnPesquisar.Enabled = True
    btnOK.Enabled = False
    btnCancelar.Enabled = False

    'limpa os valores dos controles
    optAlterar.Value = False
    optExcluir.Value = False
    optNovo.Value = False
End Sub

Private Sub DesabilitaBotoesAlteracao()
'desabilita os botões de alteração
    optAlterar.Enabled = False
    optExcluir.Enabled = False
    optNovo.Enabled = False
    btnPesquisar.Enabled = False
    btnOK.Enabled = True
    btnCancelar.Enabled = True
End Sub

Public Function ProcuraIndiceRegistroPodId(ByVal id As Long) As Long
    Dim i As Long
    Dim retorno As Long
    Dim encontrado As Boolean

    i = indiceMinimo
    With wsCadastro
        Do While Not IsEmpty(.Cells(i, colRegistro))
            If .Cells(i, colRegistro).Value = id Then
                retorno = i
                encontrado = True
                Exit Do
            End If
            i = i + 1
        Loop
    End With

    'caso não encontre o registro, retorna -1
    If Not encontrado Then
        retorno = -1
    End If

    ProcuraIndiceRegistroPodId = i
End Function

Editado Fevereiro 10, 2010 por kuroi
Adicionar tag CODE

[Paulo Eduardo Pereira]

Boa noite amigo... não sei se entendi bem seu problema, más gostaria de esclarecer que boas práticas nos levam a formatar a célula antes de atribuir um valor a ela.

Desta forma, aconselho que formate a célula antes de atribuir algum valor ... exemplo:

1º Me. txtData.Value = Format (Plan2.Range("b2").Value, "dd/mm/yyyy")

2º Plan2.Range("b2").numberformat = "dd/mm/yyyy""

3º Plan2.Range("b2").Value = CDate (txtData.Text)

E a mesma quedtão deve ser para números ... exemplo:

1º Me. txtValor.Value = Format (Plan2.Range("b3").Value, "##,###.00")

2º Plan2.Range("b3").numberformat = "##,###.00""

3º Plan2.Range("b3").Value = CDate (txtValor.Text)

Espero ter ajudado ...

abs.,

Paulo Eduardo Pereira

www.dpnet.inf.br