[Resolvido]Onde nesse codigo fica a divisão da lista ?

Nesse codigo adicionei mais 2 listas de carregamento.
Ele não está funcionando por algum motivo.

eu quero que ele divida em 6.
ele me mostra apenas as proiedades d1 d2 d3 d4 no carregamento da lista.

ao clicar no botão d5, d6 ele não salva na tabela e não carrega na lista.

Alguem poderia ajudar ?


Option Compare Database
Option Explicit

Private Sub btexcluir_Click()
On Error Resume Next
If Len(Me!tx2 & "") = 0 Then Exit Sub
msg.Titulo = "Confirmação"
msg.corpo = "Conta: " & Me!tx1 & "**Deseja excluir a conta ?"
msg.Botao = SimNao_1: msg.Imagem = Conf_2: msg.Som = Con_2
If msg.fCarregaMsg = Nao_2 Then
Me!tx1.SetFocus
Exit Sub
End If
CurrentDb.Execute "DELETE FROM tblContasDespesas WHERE id = " & Me!tx2 & ";"
fLimparCampos
End Sub

Private Sub btSalvar_Click()
Dim p As Boolean, rs As dao.Recordset, box As String
On Error Resume Next
If Len(Me!tx1 & "") = 0 Then
msg.Titulo = "Aviso"
msg.corpo = "Digite a nova conta"
msg.fCarregaMsg
Me!tx1.SetFocus
Exit Sub
End If
If Me!Sel1 = -1 Then p = True
If Me!Sel2 = -1 Then p = True
If Me!Sel3 = -1 Then p = True
If Me!Sel4 = -1 Then p = True
If Me!Sel5 = -1 Then p = True
If Me!Sel6 = -1 Then p = True
If p = False Then
If Me.OpenArgs = 0 Then
box = "Selecione uma ou mais despesas pertencentes a conta"
Else
box = "Selecione uma ou mais receitas pertencentes a conta"
End If
msg.corpo = box
msg.Titulo = "Aviso"
msg.fCarregaMsg
Me!tx1.SetFocus
Exit Sub
End If
If Len(Me!tx2 & "") = 0 Then
'Nova Descrição
Set rs = CurrentDb.OpenRecordset("tblContasDespesas")
rs.AddNew
rs!Número = DMax("número", "tblContasDespesas", "status = " & IIf(Me.OpenArgs = 0, 0, -1)) + 1
rs!NomeConta = Me!tx1
rs!Status = IIf(Me.OpenArgs = 0, False, True)
rs!Status_1 = Me!Sel1
rs!Status_2 = Me!Sel2
rs!Status_3 = Me!Sel3
rs!Status_4 = Me!Sel4
rs!Status_5 = Me!Sel5
rs!Status_6 = Me!Sel6
rs.Update
Else
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblContasDespesas WHERE id = " & Me!tx2 & ";")
rs.Edit
rs!NomeConta = Me!tx1
rs!Status = IIf(Me.OpenArgs = 0, False, True)
rs!Status_1 = Me!Sel1
rs!Status_2 = Me!Sel2
rs!Status_3 = Me!Sel3
rs!Status_4 = Me!Sel4
rs!Status_6 = Me!Sel5
rs!Status_5 = Me!Sel6
rs.Update
End If
Call fLimparCampos
Me!tx1.SetFocus
End Sub

Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
Call fCarregaLista("status = " & IIf(Me.OpenArgs = 0, 0, -1))
Call fTrocaTexto
End Sub

Private Function fTrocaTexto()
On Error Resume Next
If Me.OpenArgs = 0 Then
Me!Rot1.Caption = "D1"
Me!Rot2.Caption = "D2"
Me!Rot3.Caption = "D3"
Me!Rot4.Caption = "D4"
Me!Rot5.Caption = "D5"
Me!Rot6.Caption = "D6"
Else
Me!Rot1.Caption = "R1"
Me!Rot2.Caption = "R2"
Me!Rot3.Caption = "R3"
Me!Rot4.Caption = "R4"
Me!Rot5.Caption = "R5"
Me!Rot6.Caption = "R6"
End If
End Function

Private Function fCarregaLista(filtro As String)
On Error Resume Next
Dim mysql As String
mysql = "SELECT id, Número, NomeConta, Status, "
mysql = mysql & "iif(status_1=false,' ',iif(Status=false,'D1','R1')), "
mysql = mysql & "iif(status_2=false,' ',iif(Status=false,'D2','R2')), "
mysql = mysql & "iif(status_3=false,' ',iif(Status=false,'D3','R3')), "
mysql = mysql & "iif(status_4=false,' ',iif(Status=false,'D4','R4')), "
mysql = mysql & "iif(status_5=false,' ',iif(Status=false,'D5','R5')), "
mysql = mysql & "iif(status_6=false,' ',iif(Status=false,'D6','R6')) "
mysql = mysql & "FROM tblContasDespesas "
mysql = mysql & "WHERE " & filtro & " ORDER BY Número;"
Me!lista.RowSource = mysql
End Function

Private Function fLimparCampos()
On Error Resume Next
Me!tx1 = Null: Me!tx2 = Null: Me!Sel1 = Null
Me!Sel2 = Null: Me!Sel3 = Null: Me!Sel4 = Null: Me!Sel5 = Null: Me!Sel6 = Null
Me!tx1.SetFocus
Me!btExcluir.Enabled = False
Call fCarregaLista("status = " & IIf(Me.OpenArgs = 0, 0, -1))
End Function

Private Sub Lista_DblClick(Cancel As Integer)
On Error Resume Next
Me!tx1 = Me!lista.Column(2)
Me!tx2 = Me!lista.Column(0)
Me!Sel1 = IIf(Len(Me!lista.Column(4) & "") = 2, -1, 0)
Me!Sel2 = IIf(Len(Me!lista.Column(5) & "") = 2, -1, 0)
Me!Sel3 = IIf(Len(Me!lista.Column(6) & "") = 2, -1, 0)
Me!Sel4 = IIf(Len(Me!lista.Column(7) & "") = 2, -1, 0)
Me!Sel5 = IIf(Len(Me!lista.Column( & "") = 2, -1, 0)
Me!Sel6 = IIf(Len(Me!lista.Column(9) & "") = 2, -1, 0)
Me!btExcluir.Enabled = True
Me!tx1.SetFocus
End Sub

Private Sub Lista_LostFocus()
On Error Resume Next
Me!lista.Value = -1
End Sub

Private Sub tx1_Change()
On Error Resume Next
Dim filtro As String
If Len(Me!tx2 & "") = 0 Then
Call fCarregaLista("Nomeconta like '" & Me!tx1.Text & "*' AND status =" & IIf(Me.OpenArgs = 0, 0, -1))
End If
End Sub

Este está parecendo um código do Mestre Avelino, estou certo?

Correto.
Do programa telemax.
é a parte de pagamento e recebimento.

Estou modificando a meu gosto mas ainda estou encontrando alguns entraves...
ainda mais pq sou leigo rs...

Poderia ajudar ?
abraços

Amigão envie uma MP a ele, creio qe ele ficará feliz em ajudar além do que como foi ele que fez... ficará mais rapido a ajuda..

Cumprimentos.