[Resolvido]erro no código de parcelamento

Avelino Sampaio escreveu:Option Compare Database
Public objRibbon As IRibbonUI

Public Sub fncRibbon(ribbon As IRibbonUI)
On Error Resume Next
'--------------------------------------------------------------------
'objRibbon servirá para realizarmos alterações
'na ribbon em tempo de execução. Permite usarmos o método INVALIDATE
'--------------------------------------------------------------------
Set objRibbon = ribbon
End Sub

Public Function fncCarregaRibbon()
Dim rsRib As DAO.Recordset
Dim strsql As String
On Error GoTo trataerro
'----------------------------------------------------
'Esta função é acionada pelo módulo mod_checaVinculo
'----------------------------------------------------
strsql = "SELECT * FROM tblRibbons WHERE versao=121415 or versao=" & Val(Application.Version)
Set rsRib = CurrentDb.OpenRecordset(strsql, dbOpenDynaset)
Do While Not rsRib.EOF
Application.LoadCustomUI rsRib!RibbonName, rsRib!RibbonXml
rsRib.MoveNext
Loop
rsRib.Close
Set rsRib = Nothing
sair:
Exit Function
trataerro:
Select Case Err.Number
Case 3078
MsgBox "Tabela não encontrada...", vbInformation, "Aviso"
Case Else
MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", _
Err.HelpFile, Err.HelpContext
End Select
Resume sair:
End Function

Public Sub fncOnAction(control As IRibbonControl)
On Error GoTo trataerro
Select Case control.id
Case "btCadastro"
DoCmd.OpenForm "frm_ListaContaAcesso"
Case "btClientes"
DoCmd.OpenForm "frm_ListaCliente"
Case "btFornecedores"
DoCmd.OpenForm "frm_ListaFornecedor"
Case "btCategorias"
DoCmd.OpenForm "frm_Categoria"
Case "btContaAReceber"
DoCmd.OpenForm "frm_ListaReceitaAReceber"
Case "btContasRecebidas"
DoCmd.OpenForm "frm_LoginAcesso"
Case "btContaAPagar"
DoCmd.OpenForm "frm_ListaDespesaAPagar"
Case "btContasPagas"
DoCmd.OpenForm "frm_ListaDespesaPagas"
Case "btSair"
If MsgBox("Você deseja sair do aplicativo?", vbYesNo + vbQuestion, "Confirmação") = vbYes Then
'Esconder a "Barra de Status"
'Application.SetOption "Mostrar Barra de Status", False
Application.Quit acPrompt
End
End If
Case "btShift"
DoCmd.OpenForm "frm_LoginAcesso2"
Case "btvoltar"
DoCmd.OpenForm "frm_Movimento"
Case "btRelContasAReceberPeriodo"
DoCmd.OpenForm "frm_ConsultaMovimentoEmAbertoPeríodo"
Case "btRelContasAReceberPeriodoCliente"
DoCmd.OpenForm "frm_ConsultaMovimentoPeriodoEmAbertCliente"
Case "bt2viaRecibo"
DoCmd.OpenForm "frm_ListaRecibo"
Case "btRelacaoClientes"
DoCmd.OpenReport "rpt_Cliente"
Case "btRelacaoFornecedore"
DoCmd.OpenReport "rpt_Fornecedor"
Case "btTrocaUsuario"
DoCmd.OpenForm "frmLogin"
Case "btBackup"
DoCmd.OpenForm "frmBackup"
Case "btCadBanco"
DoCmd.OpenForm "frm_Banco"
Case "btContas"
DoCmd.OpenForm "frm_ContaBancaria"
'Relatórios
Case "btRelFinanceiro1"
DoCmd.OpenForm "frm_RelatórioDespesaEmAberto"
Case "btRelFinanceiro5"
DoCmd.OpenForm "frm_RelatorioReceitaEmAberto"
Case "btRelFinanceiro6"
DoCmd.OpenForm ""
Case "btRelFinanceiro7"
DoCmd.OpenForm ""
Case "btRelFinanceiro8"
DoCmd.OpenForm ""
Case "btRelFinanceiro5"
DoCmd.OpenForm ""
End Select
sair:
Exit Sub
trataerro:
MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
Resume sair:
End Sub

Public Function fncAbrirObjeto(NomeObjeto As String, tipoObjeto As Byte)
On Error GoTo trataerro

Select Case tipoObjeto
Case 1 'formulário
DoCmd.OpenForm NomeObjeto
Case 2 'relatório
DoCmd.OpenReport NomeObjeto, acViewPreview
Case 3 'Consulta
DoCmd.OpenQuery NomeObjeto
End Select

sair:
Exit Function
trataerro:
MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
Resume sair:
End Function

Public Sub fncGetVisible(control As IRibbonControl, ByRef visible)
Dim j As Byte
On Error GoTo trataerro
If nlogoff = False Then Exit Sub

Select Case control.id
Case "grSegurança", "grManutencao"
visible = IIf(login.id = 1, True, False)
Case "grCadastros"
If fncBloquear(1, login.id) Then j = j + 1
If fncBloquear(2, login.id) Then j = j + 1
visible = IIf(j = 2, False, True)
j = 0
Case "guiaPrincipal"
visible = True
Case Else
visible = Not Nz(fncBloquear(CLng(IIf(control.Tag = "", 0, control.Tag)), login.id), True)
End Select

sair:
Exit Sub
trataerro:
MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
Resume sair:
End Sub

Public Sub fncGetEnabled(control As IRibbonControl, ByRef enabled)
On erro GoTo trataerro
If nlogoff = False Then Exit Sub

Select Case control.Tag
Case Else
enabled = Not Nz(fncBloquear(CLng(IIf(control.Tag = "", 0, control.Tag)), login.id), True)
End Select

sair:
Exit Sub
trataerro:
MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
Resume sair:
End Sub