Administre sua Empresa – Parte II


Vamos falar sobre outros tipos de categorias. São as categorias de despesas. Lembrando que na semana passada iniciamos a série de matérias nas quais passarei algumas dicas de como se administrar uma empresa e como projetar uma aplicação em cima desta necessidade. Usando o melhor da instrução reduzida e o melhor em termos de componentes do VB.

Conforme citei: para que tenhamos um bom formulário de Contas a Pagar é necessário que o mesmo seja amarrado a um fornecedor, uma conta bancária para despesa e sobretudo categorias e subcategorias de despesa. Atualmente quanto menos você permitir o usuário digitar melhor. E isso não significa encher o seu projeto de Combos. Nem muito menos validar até a alma do programa. Lembrem-se da ilustrissíma relação Performance x Segurança.
Já pensaram se o caixa automático dos bancos perguntassem além da senha, o nome do pai e da mãe. A fila daquela joça iria dobrar. Imagine se você sobre um suave acidente e na hora de lhe internarem os caras querem saber o seu C.P.F., R.G, quantas meninas beijou no Verão e ou para as garotas, quantos rapazes foram para o diário. Sendo a sim, quanto maior a segurança, menor a performance.

>Na verdade quando resolvi planejar a idéia da Categorias e SubCategorias para Despesas usada oficialmente pela Microsoft no Money, foi pelo simples fato de que o usuário poderá cadastrar novas categorias e não precisará preencher um campo específico para a Descrição da conta a pagar. É um campo do tipo CHAR a menos na base e dois índices a mais: CDCATEGORIA, CDSUBCATEGORIA. Funcionando da seguinte maneira:

Na Categoria mulheres estão cadastradas todas as SubCategorias referentes aos gastos feitos com as mulheres. É claro, de uma forma hedionda e bem machista.

Você deve tá se perguntando: _ Legal, eu entendi, mas como codificar essa tranquerada toda no VB ?

Primeiramente o desenho da estrutura de dados é impressindível. Vincule a cada SubCategoria o código da Categoria. Veja só:

Fazer isso funcionar é bem fácil. Monte o formulário abaixo e codifique uma função espeficifa para carregar o Combo de Categorias. E em seguida, no evento Lost_Focus deste Combo (CMBCD_CATEGORIA). Carregue o outro Combo (CMBCD_SUBCATEGORIA). Aplicando um Filtro (WHERE) na montagem do RecordSet com o código da Categoria.

ModFunções

   'Módulo Básico com que conterá
   'as funções mais básicas usadas
   Option Explicit
   Dim cConn As ADODB.Connection
   Dim cStrConn As Variant
   Public cMensagem As String
   Public Const cTitulo = "FINANCEIRO"

   Public Function ConectaBanco() As Boolean

        ConectaBanco = False

        'Protegendo em memória na função
        'os objetos a serem usados
        Set cConn = New ADODB.Connection

        'Não se esqueça de direcionar o path com o banco 
        'para o diretório em que o mesmo estive em sua
        'máquina. Ou ultilize um arquivo .INI para informar
        'o path de conexão com a máquina.
         cStrConn = "Provider=Microsoft.Jet.OLEDB.4.0;"
         cStrConn = cStrConn & "Data Source=D:Imasters41ª Materiafinanceiro.mdb;"
         cStrConn = cStrConn & "Persist Security Info=False" 'Abrindo conexão    com a base

         cConn.Open cStrConn 
         Set cStrConn = Nothing

         ConectaBanco = True
End Function
   Public Function DesconectaBanco() As Boolean 
         DesconectaBanco = False

            cConn.Close
            Set cConn = Nothing

         DesconectaBanco = True

   End Function

   Public Function HabilitaCampo(NomeForm As Form, _
                                 NomeCampo As TextBox, _
                                 Habilita As Boolean)

         'Instrução Reduzida para Habilitar
         'ou desabilitar Campos

         NomeForm.NomeCampo.Enable = Habilita

   End Function
   Public Function DisparaComandos(cInstrucao As String) As Boolean

         'Esta função fará as conexões com o banco e dispará    os
         'comandos direto ao objeto de conexão
         'sem o uso de command's e ou recordset's

         DisparaComandos = False

         If ConectaBanco = True Then

            If IsNull(cInstrucao) = True Then
               cMensagem = MsgBox("ERRO INTERNO: O Banco 
Recebeu uma instrução    nula.", vbCritical, cTitulo)
               Exit Function
            End If

            cConn.Execute cInstrucao
          End If

          Call DesconectaBanco

          DisparaComandos = True

   End Function 
 

frmPCOMPRA

   Function CarregaCategoria() As Boolean

   CarregaCategoria = False
   On Error Resume Next

       Set cConn = New ADODB.Connection
       Set RS = New ADODB.Recordset

       If ConectaBanco = True Then

          cSQL = " SELECT CATEGORIASUB.CD_CATEGORIA,"
          cSQL = cSQL & " CATEGORIASUB.DS_CATEGORIA"
          cSQL = cSQL & " FROM CATEGORIASUB"

          Set RS = cConn.Execute(cSQL)
          If Err.Number <> 0 Then
             cMensagem = MsgBox("ERRO INTERNO: Não foi possível carregar as 
Categorias", vbCritical & " " & Err.Description, cTitulo)
             Exit Function
          End If

          While Not RS.EOF
             cmbcd_categoria.AddItem RS("CD_CATEGORIA") & " " & RS("DS_CATEGORIA")
             cmbcd_categoria.Refresh
             RS.MoveNext
          Wend

       End If

        Call DesconectaBanco

   CarregaCategoria = True
   End Function
Function CarregaSubCategoria() As Boolean

   CarregaSubCategoria = False
   On Error Resume Next

   Set cConn = New ADODB.Connection
   Set RS = New ADODB.Recordset

   If ConectaBanco = True Then

      cSQL = " SELECT CATEGORIASUB.CD_SUBCATEGORIA,"
      cSQL = cSQL & " CATEGORIASUB.DS_SUBCATEGORIA"
      cSQL = cSQL & " FROM CATEGORIASUB"
      cSQL = cSQL & " WHERE CATEGORIASUB.CD_CATEGORIAPAI = " 
& cmbcd_categoria.Text    & ""

      Set RS = cConn.Execute(cSQL)
      If Err.Number <> 0 Then
         cMensagem = MsgBox("ERRO INTERNO: Não foi possível 
carregar as Categorias", vbCritical & " " & Err.Description, cTitulo)
         Exit Function
      End If

      While Not RS.EOF
         cmbcd_subcategoria.AddItem RS("CD_SUBCATEGORIA") & " "    
& RS("DS_SUBCATEGORIA")
         cmbcd_subcategoria.Refresh
         RS.MoveNext
      Wend

   End If

   Call DesconectaBanco

   CarregaSubCategoria = True

End Function

Agora não se esqueça de declarar as variáveis globais e fazer a chamada da Function CarregaCategoria( ) ao carregar o formulário:

   'Exigindo que as variáveis sejam
   'declaradas e no código
   Option Explicit
   Dim cSQL As Variant
   Dim RS As ADODB.Recordset
   Dim cNovo As Boolean
Private Sub Form_Load()
   If CarregaCategoria = False Then
      cMensagem = MsgBox("Não foi possível carregar CATEGORIAS.", 
vbCritical & " " & Err.Description, cTitulo)
      Exit Sub
   End If
End Sub

Um outro assunto que quero abordar é a questão das Validações. Nem sempre encher o Form de eventos Validate é uma boa opção. Quanto mais você prende o usuário. Mais você o irrita.

Adote na programação Cliente/Servidor a mesma estética do projeto WEB. Valide tudo o que você tem que validar quando o usuário enviar os dados ao banco. O que chamamos na WEB de: “Dar o Submit”. E isso não é boiolagem !!!

Para seguir esta estética criei uma única função chamada de VALIDACAMPOS( ). Nela validarei tudo o que preciso à acionando no instante em que o feinho do usuário gravar ou atualizar algum dado. Veja só:

Function ValidaCampos() As Boolean

   ValidaCampos = False

   Dim cData As Date

   If cmbcd_categoria.Text = "(Nenhuma Categoria)" Then
      cMensagem = MsgBox("Categoria de Despesa não informada.", vbCritical, cTitulo)
      Exit Function
   End If

   If cmbcd_subcategoria.Text = "(Nenhuma SubCategoria)" Then
      cMensagem = MsgBox("SubCategoria de Desepasa não informada.", vbCritical, cTitulo)
      Exit Function
   End If

   cData = txtdt_emissao.Text
   If IsNull(cData) = True Then
      cMensagem = MsgBox("Data de Emissão não informada.", vbCritical, cTitulo)
      Exit Function
   End If

   cData = txtdt_vencimento.Text
   If IsNull(cData) = True Then
      cMensagem = MsgBox("Data de Vencimento não informada.", vbCritical, cTitulo)
      Exit Function
   End If

   cData = txtdt_pagamento.Text
   If IsNull(cData) = True Then
       txtdt_pagamento.Text = cData
       Exit Function
   End If

   If cmbds_formapg.Text = (Nenhum) Then
      cMensagem = MsgBox("Forma de Pagamento não informada.", vbCritical, cTitulo)
      Exit Function
   End If

   If txtds_juros.Text = vbNullString Then
      txtds_juros.Text = "0"
   End If

   If txtds_multa.Text = vbNullString Then
      txtds_multa.Text = ""
   End If

   If txtcd_fornecedor.Text = vbNullString Then
      cMensagem = MsgBox("Fornecedor não informado.", vbCritical, cTitulo)
      Exit Function
   End If

   If txtcd_contamemo.Text = vbNullString Then
      cMensagem = MsgBox("ContaMemo não informada.", vbCritical, cTitulo)
      Exit Function
   End If

   'Cheque
   If cmbds_formapg.ListIndex = 1 Or _
      txtcd_cheque.Text = vbNullString Then
      cMensagem = MsgBox("Pagamento em Cheque com 
número do cheque não informado.", vbCritical, cTitulo)
      Exit Function
   End If

   If txtvl_conta.Text = vbNullString Then
      cMensagem = MsgBox("Valor não informado.", vbCritical, cTitulo)
      Exit Function
   End If

   If txtvl_contapago.Text = vbNullString Then
      txtvl_contapago.Text = txtvl_conta.Text
   End If

   If txtds_obs.Text = vbNullString Then
      txtds_obs.Text = "Nenhum"
   End If

   ValidaCampos = True

   End Function




Um último assunto a ser abordado no Formulário de Contas a Pagar é a questão do Button Hit.

Trata-se de um componente construído, para vinculação de Chaves Estrangeiras. Ao invés montar um combo com todos os fornecedores cadastrados. O que com um tempo poderá levar a um Combo enorme com mais de 999 registros e conseguentemente o seu combo deixaria de funcionar ou o seu formulário demoraria uma década para carregar os dados.

Com o Button Hit o mentecapto do usuário digita o código do fornecedor ou da conta memo e o sistema pesquisa e exibe a descrição no campo ao lado. Caso não encontre, exibirá que o registro não foi encontrado. Daí se o usuário não souber o código, basta clicar no botão e chamar o cadastro de fornecedores por exemplo, para fazer a pesquisa.

Segue o código para que o Button Hit funcione. Se caso queira maiores detalhes, consulte a matéria sobre Button Hit.

Function ButtonHit(nCodigo As Integer, _
                   cTabela As String) As Boolean

   ButtonHit = False
   On Error Resume Next

   If ConectaBanco = True Then

   If IsNull(nCodigo) = True Then
      cMensagem = MsgBox("Código não Informado.", vbCritical, cTitulo)
      Exit Function
   End If

   If IsNull(cTabela) = True Then
      cMensagem = MsgBox("Tabela não encontrada.", vbCritical, cTitulo)
      Exit Function
   End If

   If Trim(cTabela) = "FORNECEDOR" Then
      cSQL = " SELECT FORNECEDOR.CD_FORNECEDOR,"
      cSQL = cSQL & " FORNECEDOR.NM_FANTASIA"
      cSQL = cSQL & " FROM FORNECEDOR"
      cSQL = cSQL & " WHERE FORNECEDOR.CD_FORNECEDOR = " & nCodigo    & ""
   Else
      cSQL = " SELECT CONTAMEMO.CD_CONTAMEMO,"
      cSQL = cSQL & " CONTAMEMO.NM_TITULAR"
      cSQL = cSQL & " FROM CONTAMEMO"
      cSQL = cSQL & " WHERE CONTAMEMO.CD_CONTAMEMO = " & nCodigo    & ""
   End If

   Set RS = cConn.Execute(cSQL)
   If Err.Number <> 0 Then
         cMensagem = MsgBox("Não foi possível carregar os dados."    _
                            , vbCritical & " " & Err.Description, cTitulo)
         Exit Function
   End If

   If IsNull(RS) = True Then
      If Trim(cTabela) = "FORNECEDOR" Then
         txtcd_fornecedor.Text = ""
         txtnm_fantasia.Text = "Fornecedor não encontrado"
         Exit Function
      Else
         txtcd_contamemo.Text = ""
         txtno_contamemo.Text = "Conta Memo não cadastrada"
         Exit Function
      End If
    End If

   If Trim(cTabela) = "FORNECEDOR" Then
      txtcd_fornecedor.Text = RS("CD_FORNECEDOR")
      txtnm_fantasia.Text = RS("NM_FANTASIA")
      Exit Function
   Else
      txtcd_contamemo.Text = RS("CD_CONTAMEMO")
      txtno_contamemo.Text = RS("NM_TITULAR")
      Exit Function
   End If

   Call DesconectaBanco
   
   End If

   ButtonHit = True

End Function

Por fim, o restante do código. Note a única rotina para Salvar e Atualizar dados. As rotinas para Exclusão e movimentação dos dados no formulário fica prá semana que vem.

Private Sub cmdContaMemo_Click()
   frmCONTAMEMO.Show
End Sub

Private Sub cmdFornecedor_Click()
   frmFORNECEDORES.Show
End Sub

Private Sub cmdNova_Click()
   cNovo = True
End Sub

Private Sub cmdSair_Click()
   End
End Sub

Private Sub cmdSalvar_Click()
   If ValidaCampos = False Then
      Exit Sub
   End If

   If cNovo = True Then
      cSQL = " INSERT INTO PCOMPRA"
      cSQL = cSQL & " (PCOMPRA.CD_CATEGORIA,"
      cSQL = cSQL & " PCOMPRA.CD_SUBCATEGORIA,"
      cSQL = cSQL & " PCOMPRA.CD_FORNECEDOR,"
      cSQL = cSQL & " PCOMPRA.CD_CONTAMEMO,"
      cSQL = cSQL & " PCOMPRA.DT_PAGAMENTO,"
      cSQL = cSQL & " PCOMPRA.DT_VENCIMENTO,"
      cSQL = cSQL & " PCOMPRA.DT_EMISSAO,"
      cSQL = cSQL & " PCOMPRA.DS_OBS,"
      cSQL = cSQL & " PCOMPRA.DS_FORMAPG,"
      cSQL = cSQL & " PCOMPRA.CD_CHEQUE,"
      cSQL = cSQL & " PCOMPRA.VL_CONTA,"
      cSQL = cSQL & " PCOMPRA.VL_CONTAPAGO,"
      cSQL = cSQL & " PCOMPRA.DS_JUROS,"
      cSQL = cSQL & " PCOMPRA.DS_MULTA)"
      cSQL = cSQL & " VALUES(" & cmbcd_categoria.Text & ","
      cSQL = cSQL & " " & cmbcd_subcategoria.Text & ","
      cSQL = cSQL & " " & txtcd_contamemo.Text & ","
      cSQL = cSQL & " '" & txtdt_pagamento.Text & "',"
      cSQL = cSQL & " '" & txtdt_vencimento.Text & "',"
      cSQL = cSQL & " '" & txtdt_emissao.Text & "',"
      cSQL = cSQL & " '" & txtds_obs.Text & "',"
      cSQL = cSQL & " '" & cmbds_formapg.Text & "',"
      cSQL = cSQL & " " & txtcd_cheque.Text & ","
      cSQL = cSQL & " " & txtvl_conta.Text & ","
      cSQL = cSQL & " " & txtvl_contapago.Text & ","
      cSQL = cSQL & " " & txtds_juros.Text & ","
      cSQL = cSQL & " " & txtds_multa.Text & ")"
      cMensagem = "Dados Gravados com Sucesso."
   Else
      cSQL = " UPDATE PCOMPRA SET"
      cSQL = cSQL & " PCOMPRA.CD_CATEGORIA = " & cmbcd_categoria.Text    & ","
      cSQL = cSQL & " PCOMPRA.CD_SUBCATEGORIA = " & cmbcd_subcategoria.Text    & ","
      cSQL = cSQL & " PCOMPRA.CD_FORNECEDOR = " & txtcd_fornecedor.Text    & ","
      cSQL = cSQL & " PCOMPRA.CD_CONTAMEMO = " & txtcd_contamemo.Text    & ","
      cSQL = cSQL & " PCOMPRA.DT_PAGAMENTO = '" & txtdt_pagamento.Text    & "',"
      cSQL = cSQL & " PCOMPRA.DT_VENCIMENTO = '" & txtdt_vencimento.Text    & "',"
      cSQL = cSQL & " PCOMPRA.DT_EMISSAO = '" & txtdt_emissao.Text    & ","
      cSQL = cSQL & " PCOMPRA.DS_OBS = '" & txtds_obs.Text &    "',"
      cSQL = cSQL & " PCOMPRA.DS_FORMAPG = '" & cmbds_formapg.Text    & "',"
      cSQL = cSQL & " PCOMPRA.CD_CHEQUE = " & txtcd_cheque.Text    & ","
      cSQL = cSQL & " PCOMPRA.VL_CONTA = " & txtvl_conta.Text &    ","
      cSQL = cSQL & " PCOMPRA.VL_CONTAPAGO = " & txtvl_contapago.Text    & ","
      cSQL = cSQL & " PCOMPRA.DS_JUROS = " & txtds_juros.Text &    ","
      cSQL = cSQL & " PCOMPRA.DS_MULTA = " & txtds_multa.Text &    ""
      cSQL = cSQL & " WHERE PCOMPRA.CD_PCOMPRA = " & txtcd_conta.Text    & ""
      cMensagem = "Dados Atuallizados com Sucesso."
   End if

     If DisparaComandos(cSQL) = True Then
        cMensagem = MsgBox(cMensagem, vbInformation, cTitulo)
     Else
        cMensagem = MsgBox("ERRO INTERNO: Não foi possível executar    
a operação" & " " & Err.Description, vbCritical,    cTitulo)
        Exit Sub
      End If
   End If

End Sub
 

Agora parem tudo !!! Largem o copo de leite, desliguem a TV, tranquem as portas . . .

Quase todo iniciante em VB tem dúvidas na hora de aplicar um filtro e gerar uma SPREAD, um GRID em cima destes dados filtrados. Exemplo: Selecionar todas as contas a pagar em um determinado período de vencimento. Observe:

frmGRIDPCOMPRA

   Option Explicit
   Dim cSQL As Variant
   Dim cMensagem As String
   Dim RS As New ADODB.Recordset

Private Sub Form_Load()
   If CarregaGrid = False Then
      cMensagem = MsgBox("ERRO INTERNO: Não foi possível carregar os dados.", 
vbCritical & " " & Err.Description, cTitulo)
      Exit Sub
   End If
End Sub

Function CarregaGrid() As Boolean
   CarregaGrid = False

   Set cConn = New ADODB.Connection
   Set RS = New ADODB.Recordset
   Dim cDataInicial As Date
   Dim cDataFinal As Date

   cDataIncial = InputBox("Digite a Data Inicial", cTitulo, cDataInicial)
   cDataFinal = InputBox("Digite a Data Final", cTitulo, cDataFinal)
   cSQL = " SELECT PCOMPRA.CD_PCOMPRA ""Código"""
   cSQL = cSQL & " PCOMPRA.CD_CATEGORIA ""Categoria"""
   cSQL = cSQL & " PCOMPRA.CD_SUBCATEGORIA ""SubaCategoria"""
   cSQL = cSQL & " PCOMPRA.VL_CONTA ""Valor"""
   cSQL = cSQL & " PCOMPRA.DT_VENCIMENTO ""Vencimento"""
   cSQL = cSQL & " WHERE PCOMPRA.DT_VENCIMENTO >= '" & Format(cDataInicial,
    "dd/mm/yyyy") & "',"
   cSQL = cSQL & " AND PCOMPRA.DT_VENCIMENTO <= '" & Format(cDataFinal,
    "dd/mm/yyyy") & ""
  Set RS = cConn.Execute(cSQL)

   Set grdPCONTA.DataSource = RS

   CarregaGrid = True

End Function

>O segredo está em deixar o formulário solto e gerar uma instrução SQL passando como parâmetros as datas imputadas e em seguida carregando um objeto Recordset e passando o mesmo como propriedade DataSource para o GRID. Fazendo isso, o seu Grid, será carregado em tempo de execução com os dados filtrados. E quantas e quantas vezes você disparar esta função, o seu Grid será atualizado.

Legenda do código:

Comentários
Destaque
Códigos

Finalmente concluimos o Form de Contas a Pagar e na semana que vem. Eu volto com os formulários restantes.

Abraços a todos!

Publicado em 29 de dezembro de 2008, em VBA. Adicione o link aos favoritos. Deixe um comentário.

Deixe uma resposta

Preencha os seus dados abaixo ou clique em um ícone para log in:

Logotipo do WordPress.com

Você está comentando utilizando sua conta WordPress.com. Sair / Alterar )

Imagem do Twitter

Você está comentando utilizando sua conta Twitter. Sair / Alterar )

Foto do Facebook

Você está comentando utilizando sua conta Facebook. Sair / Alterar )

Foto do Google+

Você está comentando utilizando sua conta Google+. Sair / Alterar )

Conectando a %s

%d blogueiros gostam disto: