dt picker (data em banco de dados)

Galera do VBWEB, Boa Tarde.

Estou com um formulário, cuja sua função é gerar boletos bancários.

Nele eu possuao um dtpicker(calendário), eu marco uma data nele, como data de fencimento, mas na hora de gerar a boleta e grava como 10/mes/ano. Ou seja ele coloca o dia dez como default.

Como resolvo esse problema.

Desde já , Muito Obrigado.

Quem puder me ajudar e dar uma solução agradeço desde já.

Segue abaixo o código de todo o form:

Private Sub btnCadMensagens_Click()
frmBolConfigMens.Show vbModal
End Sub

Private Sub btnCadTaxas_Click()
frmEBolCadTaxas.Show vbModal
End Sub

Private Sub btnEditarBol_Click()
'FrmEBolEditar.Show vbModal
End Sub

Private Sub btnImpressao_Click()
FrmEBoletasImprimir.Show vbModal
End Sub

Private Sub btnGrvar_Click()
GravarBoletas
End Sub

Private Sub GravarBoletas()
    On Error GoTo TrataErro
    Dim i, j, k As Integer
    Dim strAD, strAU As String
    Dim rstAD As ADODB.Recordset
    Dim rstAU As ADODB.Recordset
    Dim rstG As ADODB.Recordset

    Set rstAD = New ADODB.Recordset
    Set rstAU = New ADODB.Recordset
    Set rstG = New ADODB.Recordset

    strAD = "select * from tab_boleta where tpboleta = 'N' and referencia = '" & cmbReferencia.Text & "' and imprimir = 0 "
    rstAD.Open strAD, ConexaoAtual, adOpenStatic, adLockReadOnly, 0
    If rstAD.RecordCount > 0 Then
        If MsgBox("Existem Boletas criadas com esta Referência!" & vbCr & "Deseja grava-las novamente?", vbOKCancel) = vbCancel Then
            Exit Sub
        Else
            ConexaoAtual.Execute "delete from tab_boleta where tpboleta = 'N' and referencia = '" & cmbReferencia.Text & "' and imprimir = 0 "
        End If
    End If
    rstAD.Close
    strAD = "select * from tab_auxdados"
    rstAD.Open strAD, ConexaoAtual, adOpenStatic, adLockReadOnly, 0

    If rstAD.RecordCount = 0 Then Exit Sub
    Dim ref, Ufir, descate, Vdtdcate, mtapos, Vdtmtapos, VdtEm, mes, ano, lpg As String
    Dim vtot, vtx, VdtVenc, msg, multa, mora, desp As String
    Dim apt, cdtx, tptx, cdbol As Integer
    Dim cdtxBol As Integer

    ano = Mid(cmbReferencia.Text, 1, 4)
    mes = Mid(cmbReferencia.Text, 5, 6)
    ref = cmbReferencia.Text
    Ufir = Trim(txtUfir.Text)
    descate = Trim(txtDescAte.Text)
    Vdtdcate = str(dtDescAte.Value)
    mtapos = Trim(txtMultaApos.Text)
    Vdtmtapos = str(dtMultaApos.Value)
    VdtEm = Trim(txtEmissao.Text)
    lpg = Trim(txtLocPag.Text)
    multa = Trim(txtMulta.Text)
    mora = Trim(txtMora.Text)

    On Error GoTo ErroTrans
    ConexaoAtual.BeginTrans
    For k = 0 To rstAD.RecordCount - 1
        apt = rstAD!cd_apart
        ref = rstAD!referencia
        VdtVenc = rstAD!vencimento
        vtot = rstAD!ValorFinal
        vtx = rstAD!valortaxa
        msg = rstAD!Mensagem
        desp = rstAD!descespecial
        cdbol = GravaAutoInc("tab_boleta")
        rstG.CursorType = adOpenDynamic
        rstG.CursorLocation = adUseServer
        rstG.ActiveConnection = ConexaoAtual
        rstG.Open "select * from tab_boleta", ConexaoAtual, adOpenDynamic, adLockBatchOptimistic, 0
        With rstG
            .AddNew
            !cd_boleta = cdbol
            !referencia = ref
            !cd_apart = apt
            !tpboleta = "N"
            !Ufir = Ufir
            !desc_ate = descate
            !dt_descate = Vdtdcate
            !multapos = mtapos
            !dt_multapos = Vdtmtapos
            !valtotal = vtot
            !valoracordo = Null
            !dt_emissao = VdtEm
            !dt_vencimento = VdtVenc
            !dt_pag = Null
            !status_pag = "NORMAL"
            !val_pag = "0,00"
            !mes = mes
            !ano = ano
            !locpag = lpg
            !mensagens = msg
            !multa = multa
            !mora = mora
            !desc_especial = desp
            !valtaxas = vtx
            !via = "1ª"
            .UpdateBatch
            .Close
        End With
        strAU = "select * from tab_aux where cd_apart = " & apt
        rstAU.Open strAU, ConexaoAtual, adOpenStatic, adLockReadOnly, 0
        For j = 0 To rstAU.RecordCount - 1
            cdtxBol = rstAU!taxa
            ConexaoAtual.BeginTrans
            ConexaoAtual.Execute "insert into tab_txbol(cd_boleta,cd_taxa)values(" & cdbol & ", " & cdtxBol & ")"
            ConexaoAtual.CommitTrans
            rstAU.MoveNext
        Next j
        rstAU.Close
        rstAD.MoveNext
    Next k
    rstAD.Close

    GravaHistBoletas
    ConexaoAtual.Execute "delete from tab_aux"
    ConexaoAtual.Execute "delete from tab_auxdados"
    ConexaoAtual.CommitTrans
    MsgBox "Boletas Gravadas com Sucesso!"
    ConexaoAtual.Execute "delete from tab_aux"
    ConexaoAtual.Execute "delete from tab_auxdados"
Exit Sub
ErroTrans:
    ConexaoAtual.RollbackTrans
    ConexaoAtual.Execute "delete from tab_aux"
    ConexaoAtual.Execute "delete from tab_auxdados"
    MsgBox "Erro na Gravação: erro nº" & Err.Number & "-" & Err.Description
    Exit Sub
TrataErro:
    MsgBox "Erro na Gravação: erro nº" & Err.Number & "-" & Err.Description
End Sub

Private Sub GravaHistBoletas()
    Dim str As String
    Dim anoU, mesU As String
    anoU = Mid(cmbReferencia.Text, 1, 4)
    mesU = Mid(cmbReferencia.Text, 5, 2)
    Dim rstT As ADODB.Recordset
    Set rstT = New ADODB.Recordset
    Dim rstV As ADODB.Recordset
    Set rstV = New ADODB.Recordset
    str = "select distinct(taxa) as taxaU from tab_aux"
    rstT.Open str, ConexaoAtual, adOpenStatic, adLockReadOnly, 0
    If rstT.RecordCount = 0 Then Exit Sub
    For i = 0 To rstT.RecordCount - 1
        str = "select distinct(valor) as valorU from tab_aux where taxa = " & rstT!taxaU
        rstV.Open str, ConexaoAtual, adOpenStatic, adLockReadOnly, 0
        str = "insert into tab_taxas_hist(cd_taxa, valor, ano, mes) values (" & rstT!taxaU & ", '" & rstV!valorU & "', '" & anoU & "', '" & mesU & "')"
        ConexaoAtual.Execute str
        rstV.Close
        rstT.MoveNext
    Next i
End Sub

Private Sub btnSair_Click()
Unload Me
End Sub

Private Sub Form_Activate()
    txtUfir.Text = PegaUfir(cmbReferencia.Text)
    If txtUfir.Text = "0,00" Then
        frmCadUfir.Show
        MsgBox "Cadastre a Ufir!", vbInformation, "Gravando Boletas..."
    End If
End Sub

Private Sub Form_Load()
    'Me.Caption = strFormCaption
    'Centraliza_Form Me
    MostraReferencia
    CarregarTela

End Sub

Private Sub MostraReferencia()
    Dim i As Integer
    Dim ano, mes, mes2 As String
    ano = Year(Date)
    mes = IIf(Len(Month(Date)) = 2, Month(Date), "0" & Month(Date))
    mes2 = IIf(Len(Month(Date) + 1) = 2, Month(Date) + 1, "0" & Month(Date) + 1)
    cmbReferencia.Text = ano & mes
    cmbReferencia.AddItem ano & mes, 0
    cmbReferencia.AddItem ano & mes2, 1
End Sub

Private Function PegaUfir(ByVal ref As String) As String
    Dim StrSql As String
    Dim rstU As ADODB.Recordset
    Set rstU = New ADODB.Recordset
    StrSql = "Select * from tab_ufir where ref_ufir = '" & ref & "'"

    rstU.Open StrSql, ConexaoAtual, adOpenStatic, adLockReadOnly, 0

    If rstU.RecordCount = 0 Then
        txtUfir.Text = "0,00"
    Else
        PegaUfir = rstU!val_ufir
    End If
End Function

Private Sub CarregarTela()
    txtEmissao.Text = Date
    dtDescAte.Value = Date
    dtDescAte.Day = 5
    dtMultaApos.Value = Date
    dtMultaApos.Day = 20
    dtVenciNormal.Value = Date
    dtVenciNormal.Day = 10
    txtUfir.Text = PegaUfir(cmbReferencia.Text)
    txtMora.Text = "1"
    txtMulta.Text = "2"
    txtMultaApos.Text = "0"
    txtDescAte.Text = "0"
    txtNossoNum.Text = ""
    txtLocPag.Text = "Em toda rede bancária até a data do vencimento"
    If VerBoletas = True Then
        btnCadMensagens.Enabled = True
        btnCadTaxas.Enabled = True
        btnEditarBol.Enabled = Not btnEditarBol.Enabled
    End If
    GravaAuxDados
End Sub

Private Sub GravaAuxDados()
    Dim StrSql, ref, mens, ValTx, valF, desp, Venc As String
    Dim i, apt As Integer
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset

    StrSql = "select * from TAB_BLOCO b, tab_apto ap where ap.cd_bloco = b.cd_bloco and b.cd_condo = '" & CDCONDOMINIO & "'"
    ref = cmbReferencia.Text
    mens = "Mantenha o pagamento de sua taxa de Condomínio em dia!" 'PegaMensagem(cmbApartBol(1).Text)
    Venc = str(dtVenciNormal.Value)
    rst.Open StrSql, ConexaoAtual, adOpenStatic, adLockReadOnly, 0
    If rst.RecordCount = 0 Then Exit Sub
    ConexaoAtual.BeginTrans
    ConexaoAtual.Execute "delete from tab_auxdados"
    ConexaoAtual.CommitTrans
    ConexaoAtual.BeginTrans
    For i = 0 To rst.RecordCount - 1
        apt = rst!cd_apart
        ValTx = "0,00"
        desp = "0"
        valF = "0,00" 'Format(valTx - valTx * desp / 100, "##,##0.00")
        On Erro GoTo ErroTrans
        ConexaoAtual.Execute "insert into tab_auxdados( referencia, cd_apart, valortaxa, valorfinal, mensagem, vencimento, descespecial) " & _
                     "values('" & ref & "'," & apt & ",'" & ValTx & "','" & valF & "','" & mens & "','" & Venc & "','" & desp & "')"
        rst.MoveNext
    Next i
    ConexaoAtual.CommitTrans
    Exit Sub
ErroTrans:
    ConexaoAtual.RollbackTrans
End Sub

Private Function VerBoletas() As Boolean
    Dim str As String
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    str = "Select * from tab_boleta where referencia = '" & cmbReferencia.Text & "'"

    rst.Open str, ConexaoAtual, adOpenStatic, adLockReadOnly, 0

    If rst.RecordCount = 0 Then
        VerBoletas = False
    Else
        VerBoletas = True
    End If
End Function

Private Sub txtDescAte_LostFocus()
If txtDescAte.Text = "" Then txtDescAte.Text = "0"
End Sub

Private Sub txtEmissao_LostFocus()
If txtEmissao.Text = "" Then txtEmissao.Text = Date
End Sub

Private Sub txtLocPag_LostFocus()
If txtLocPag.Text = "" Then txtLocPag.Text = "Em toda rede ban cária até a data do vencimento"
End Sub

Private Sub txtMora_LostFocus()
If txtMora.Text = "" Then txtMora.Text = "0"
End Sub

Private Sub txtMulta_LostFocus()
If txtMulta.Text = "" Then txtMulta.Text = "0"
End Sub

Private Sub txtMultaApos_LostFocus()
If txtMultaApos.Text = "" Then txtMultaApos.Text = "0"
End Sub