descrição do código de banco de dados.

Question

Prezados colegas, não sou programados, sou apenas alguém que gosta de tentar aprender VBA.

Estou aos poucos melhorando, aprendendo por comparação e testando modificações.

Bom, há tempos que tento fazer um banco de dados em VBA, e já consigo realizar uma parte, a da inserção dos dados. Porém, na parte de pesquisa e alteração ainda não consigo. Eu encontrei um banco de dados aqui no site, tem um código que me parece não muito complicado, mas precisaria que alguem me dissesse o que cada linha faz exatamente e por quê?

Alguém poderia me ajudar detalhadamente em linguagem não técnica?

As coisas que descubro estou transcrevendo e fazendo um manual de linhas de código de VBA, mas para pessoas que como eu gosta, mas não tem base para fazer muitas coisas. 

Alguém se dispõem?

Segue código e vc pode selecionar um bloco e explicar se entender melhor.:

Option Explicit

Const colCodigo As Integer = 1
Const colDescricao_da_Conta As Integer = 2
Const coldata_vencimento As Integer = 3
Const colvalor As Integer = 4
Const coldata_pagto As Integer = 5
Const colStatus As Integer = 6
Const indiceMinimo As Byte = 2
Const corDisabledTextBox As Long = -2147483633
Const corEnabledTextBox As Long = -2147483643

Private wscontas_a_pagar 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 btnfechar_Click()
    Unload frmcontas_a_Pagar
End Sub

Private Sub btnimprimir_Click()
    curprtarea = ActiveSheet.PageSetup.PrintArea
    MyPrtArea = "B1:J10"
    ActiveSheet.PageSetup.PrintArea = MyPrtArea
    ActiveSheet.PrintOut
    ActiveSheet.PageSetup.PrintArea = curprtarea
End Sub

Private Sub btnOK_Click()
    Dim proximoId As Long

    'Altera
    If optAlterar.Value Then
        Call SalvaRegistro(CLng(txtCodigoConta.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 = wscontas_a_pagar.UsedRange.Rows.Count + 1
        Call SalvaRegistro(proximoId, proximoIndice)
        txtCodigoConta = 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º " & txtCodigoConta.Text & " ?", vbYesNo, "Confirmação")

        If result = vbYes Then
            wscontas_a_pagar.Range(wscontas_a_pagar.Cells(indiceRegistro, colCodigo), wscontas_a_pagar.Cells(indiceRegistro, colCodigo)).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()
    frmPesqConta.Show
End Sub
Private Sub optAlterar_Click()
    If txtCodigoConta.Text <> vbNullString And txtCodigoConta.Text <> "" Then
        Call HabilitaControles
        Call DesabilitaBotoesAlteracao
        'dá o foco ao primeiro controle de dados
        txtDescricaoConta.SetFocus
    Else
        lblMensagem.Caption = "Não há registro a ser alterado"
    End If
End Sub

Private Sub optExcluir_Click()
    If txtCodigoConta.Text <> vbNullString And txtCodigoConta.Text <> "" Then
        Call DesabilitaBotoesAlteracao
        lblMensagem.Caption = "Modo de exclusão. Confira os 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
    txtDescricaoConta.SetFocus
End Sub

Private Sub Txtvalor_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    txtvalor.Text = Format(txtvalor.Text, "#,##0.00")
End Sub

Private Sub UserForm_Initialize()
    Set wscontas_a_pagar = ThisWorkbook.Worksheets("Contas_a_Pagar")
    Call HabilitaBotoesAlteracao
    Call CarregaDadosInicial
    Call DesabilitaControles
   ' EscondeX Me
'    lblcontaspagar = ThisWorkbook.Worksheets("empresa").Range("b2")
    cmbcondicao.AddItem "Pago"
    cmbcondicao.AddItem "A Pagar"
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 < wscontas_a_pagar.UsedRange.Rows.Count Then
        indiceRegistro = indiceRegistro + 1
    End If
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub btnUltimo_Click()
    indiceRegistro = wscontas_a_pagar.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 wscontas_a_pagar
        If Not IsEmpty(.Cells(indiceRegistro, colDescricao_da_Conta)) Then
            Me.txtCodigoConta.Text = .Cells(indiceRegistro, colCodigo).Value
            Me.txtDescricaoConta.Text = .Cells(indiceRegistro, colDescricao_da_Conta).Value
            Me.txtvencimento.Text = .Cells(indiceRegistro, coldata_vencimento).Value
            Me.txtpagto = .Cells(indiceRegistro, coldata_pagto).Value
            Me.txtvalor.Text = .Cells(indiceRegistro, colvalor).Value
            cmbcondicao.Text = .Cells(indiceRegistro, colStatus).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 wscontas_a_pagar
        .Cells(indice, colCodigo).Value = Id
        .Cells(indice, colDescricao_da_Conta).Value = Me.txtDescricaoConta.Text
        .Cells(indice, coldata_vencimento).Value = txtvencimento.Value
        .Cells(indice, coldata_pagto).Value = txtpagto.Value
        .Cells(indice, colvalor).Value = Me.txtvalor.Text
        .Cells(indice, colStatus).Value = cmbcondicao
    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 = wscontas_a_pagar.Range(wscontas_a_pagar.Cells(indiceMinimo, colCodigo), wscontas_a_pagar.Cells(wscontas_a_pagar.UsedRange.Rows.Count, colCodigo))
    PegaProximoId = WorksheetFunction.Max(rangeIds) + 1
End Function

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

Private Sub LimpaControles()
    Me.txtCodigoConta.Text = ""
    Me.txtDescricaoConta.Text = ""
    Me.txtvencimento.Text = ""
    Me.txtpagto.Text = ""
    Me.txtvalor.Text = ""
    cmbcondicao.Text = ""
    
End Sub

Private Sub HabilitaControles()
'Me.txtCodigoConta.Locked = False
    Me.txtDescricaoConta.Locked = False
    
    Me.txtDescricaoConta.BackColor = corEnabledTextBox
    Me.txtvencimento.BackColor = corEnabledTextBox
    Me.txtpagto.BackColor = corEnabledTextBox
    Me.txtvalor.BackColor = corEnabledTextBox
    cmbcondicao.BackColor = corEnabledTextBox
End Sub

Private Sub DesabilitaControles()
'Me.txtCodigoConta.Locked = True
    Me.txtDescricaoConta.Locked = True
    
    Me.txtDescricaoConta.BackColor = corDisabledTextBox
    Me.txtvencimento.BackColor = corDisabledTextBox
    Me.txtpagto.BackColor = corDisabledTextBox
    Me.txtvalor.BackColor = corDisabledTextBox
    cmbcondicao.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 wscontas_a_pagar
        Do While Not IsEmpty(.Cells(i, colCodigo))
            If .Cells(i, colCodigo).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






E outra parte na busca:





Option Explicit

'constantes para auxiliar na verificação do código
Private Const Ascendente As Byte = 0
Private Const Descendente As Byte = 1
Private wscontas_a_pagar As Worksheet

Private Sub btnfechar_Click()
    Unload frmPesqConta
End Sub
Private Sub btnfiltrar_Click()
'Se os Campos Datas estiverem Vazios
If txtdtinicio <> "" And txtdtfim <> "" Then

    Call PopulaListBox(txtdtinicio.Text, txtdtfim.Text)
    'Total Geral
    Dim lItem As Double
    Dim i As Double
    Dim x As Double
    Dim valor As Double
    Dim valor1 As Double
    Dim valor2 As Double
    lbltotal = 0
    lbltotal1 = 0
    lbltotal2 = 0
    lblmsg1 = ""
    lblmsg2 = ""
    Dim sPagam
    
    'Total GERAL
    'If lbltotal.Caption = "" Then lbltotal.Caption = 0
    
    'Preenche lblTotal com o TOTAL GERAL Pagos e A Pagar
        For lItem = 1 To lstLista.ListCount - 1
            valor = lstLista.List(lItem, 3) * 1
            lbltotal = (lbltotal.Caption) + (valor)
        Next
        lblMsg = "Total:"
        lbltotal = Format(lbltotal, "R$ #,##0.00")
        
    'Total A Pagar
    'If ["status"] = "Pago" Then lbltotal1.Caption = 0
    'lbltotal1.Caption = 0
    
     'Total A Pagar
        For x = 1 To lstLista.ListCount - 1
            'Captura o Valor na Coluna STATUS
            sPagam = lstLista.List(x, 5)
           'Se valor =  Pago
           If sPagam = "Pago" Then
                valor1 = lstLista.List(x, 3) * 1
                lbltotal1 = (lbltotal1.Caption) + (valor1)
            'Se Não valor = A Pagar
            Else: sPagam = "A Pagar"
                valor2 = lstLista.List(x, 3) * 1
                lbltotal2 = (lbltotal2.Caption) + (valor2)
            End If
            'End If
        Next
            
            'Eu ja deixaria estas mensagens direto nos Label, são desnecessárias
            'Evitando de ter carrega-las, seria umas linhas a menos na rotina
            lblmsg1 = "Total Pago:"
            lbltotal1 = Format(lbltotal1, "R$ #,##0.00")
                lblmsg2 = "Total A Pagar:"
                lbltotal2 = Format(lbltotal2, "R$ #,##0.00")
   
   ' If ["status"] = "A Pagar" Then lbltotal2.Caption = 0
   '     For i = 1 To lstLista.ListCount - 1
   '         valor2 = lstLista.List(i, 3) * 1
   '         lbltotal2 = (lbltotal2.Caption) + (valor2)
   '     Next
Else
        MsgBox "Campos - Datas Inicial ou Final em branco !!!"
        'Limpa ListBox
        lstLista.Clear
 End If
End Sub

Private Sub lstLista_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If lstLista.ListIndex > 0 Then
        Dim indiceRegistro As Long
        indiceRegistro = frmcontas_a_Pagar.ProcuraIndiceRegistroPodId(lstLista.List(lstLista.ListIndex, 0))
        If indiceRegistro <> -1 Then
            Call frmcontas_a_Pagar.CarregaRegistroPorIndice(indiceRegistro)
        End If
        Unload Me
    Else
        lblMensagens.Caption = "É preciso selecionar um item válido na lista"
    End If
End Sub

Private Sub UserForm_Initialize()
   ' EscondeX Me
    Call PopulaListBox(vbNullString, vbNullString)
    'cmbstatus.AddItem ""
    'cmbstatus.AddItem "Pago"
    'cmbstatus.AddItem "A Pagar"
    
End Sub
Private Sub PopulaListBox(ByVal txtdtinicio, txtdtfim)

    On Error GoTo TrataErro

    Dim conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim sql As String
    Dim sqlWhere As String
    Dim sqlOrderBy As String
    Dim i As Integer
    Dim campo As Field
    Dim myArray() As Variant
    
    Set conn = New ADODB.Connection
    With conn
        .Provider = "Microsoft.JET.OLEDB.4.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0;"
        .Open
    End With

    'sql = "SELECT * FROM [Contas_a_Pagar$]"
    
    sql = "Select * From [Contas_a_Pagar$] Where [DATA_VENCIMENTO] >= #" & Format(txtdtinicio, "mm/dd/yyyy") & "#   AND DATA_VENCIMENTO <= #" & Format(txtdtfim, "mm/dd/yyyy") & "#ORDER BY Status"
      
    'faz a união da string SQL com a cláusula WHERE
    If sqlWhere <> vbNullString Then
        sql = sql & " WHERE " & sqlWhere
    End If

    Set rst = New ADODB.Recordset
    With rst
        .ActiveConnection = conn
        .Open sql, conn, adOpenDynamic, _
              adLockBatchOptimistic
    End With

    'pega o número de registros para atribuí-lo ao listbox
    lstLista.ColumnCount = rst.Fields.Count
    lstLista.ColumnWidths = "1 cm;4 cm;3 cm;2 cm;2 cm;2 cm;1"

    'coloca as linhas do RecordSet num Array, se houver linhas neste
    If Not rst.EOF And Not rst.BOF Then
        myArray = rst.GetRows
        'troca linhas por colunas no Array
        myArray = Array2DTranspose(myArray)
        'atribui o Array ao listbox
        lstLista.List = myArray
        'adiciona a linha de cabeçalho da coluna
        lstLista.AddItem , 0
        'preenche o cabeçalho
        For i = 0 To rst.Fields.Count - 1
            lstLista.List(0, i) = rst.Fields(i).Name
        Next i
        'seleciona o primeiro item da lista
        lstLista.ListIndex = 0
    Else
        lstLista.Clear
    End If

    'atualiza o label de mensagens
    If lstLista.ListCount <= 0 Then
        lblMensagens.Caption = lstLista.ListCount & " registros encontrados"
    Else
        lblMensagens.Caption = lstLista.ListCount - 1 & " registros encontrados"
    End If

    ' Fecha o conjunto de registros.
    Set rst = Nothing
    ' Fecha a conexão.
    conn.Close

TrataSaida:
    Exit Sub
TrataErro:
    Debug.Print Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
    Resume TrataSaida
End Sub

Private Sub MontaClausulaWhere(ByVal NomeControle As String, ByVal NomeCampo As String, ByRef sqlWhere As String)
'NomeDoControle
    If Trim(Me.Controls(NomeControle).Text) <> vbNullString Then
        If sqlWhere <> vbNullString Then
            sqlWhere = sqlWhere & " AND"
        End If
        sqlWhere = sqlWhere & " " & NomeCampo & " LIKE '%" & Trim(Me.Controls(NomeControle).Text) & "%'"
    End If
End Sub


'Faz a transpasição de um array, transformando linhas em colunas
Private Function Array2DTranspose(avValues As Variant) As Variant
    Dim lThisCol As Long, lThisRow As Long
    Dim lUb2 As Long, lLb2 As Long
    Dim lUb1 As Long, lLb1 As Long
    Dim avTransposed As Variant

    If IsArray(avValues) Then
        On Error GoTo ErrFailed
        lUb2 = UBound(avValues, 2)
        lLb2 = LBound(avValues, 2)
        lUb1 = UBound(avValues, 1)
        lLb1 = LBound(avValues, 1)

        ReDim avTransposed(lLb2 To lUb2, lLb1 To lUb1)
        For lThisCol = lLb1 To lUb1
            For lThisRow = lLb2 To lUb2
                avTransposed(lThisRow, lThisCol) = avValues(lThisCol, lThisRow)
            Next
        Next
    End If

    Array2DTranspose = avTransposed
    Exit Function

ErrFailed:
    Debug.Print Err.Description
    Debug.Assert False
    Array2DTranspose = Empty
    Exit Function
    Resume
End Function

Agradeço a todos pelo auxílio e assim que estiver em condições coloco minhas anotações no forum.