API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jun 14th, 2019
257
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 61.41 KB | None | 0 0
raw download clone embed print report
  1. Public Function GeraRel()
  2.  
  3.   On Error GoTo erro
  4.  
  5.  
  6.     'Obs 1mm = 56.7 Twip
  7.    
  8.     IniRel  'Inicia o relatório
  9.    
  10.     Dim pag As Boolean
  11.     Dim a As Integer
  12.     Dim vComplemento As String
  13.     Dim fVencimento As Single
  14.     Dim vLinhaD As String
  15.     Dim vLinhaD1 As String
  16.     Dim vLinhaD2 As String
  17.     Dim vLinhaD3 As String
  18.     Dim vLinhaD4 As String
  19.     Dim vLinhaD5 As String
  20.     Dim vCodBar As String
  21.     Dim vIVR As Boolean
  22.     Dim vNossoNum As String
  23.     Dim vConta As String
  24.     Dim vDigConta As String
  25.     Dim vAgencia As String
  26.     Dim vDigAgencia As String
  27.     Dim vBanco As String
  28.     Dim vCodConvenio As String
  29.     Dim vCarteira As String
  30.     Dim vCampoLivre As String
  31.     Dim vValorBoleto As Currency
  32.     Dim vServico(1 To 20) As String
  33.     Dim vDiscriminacao(1 To 20) As String
  34.     Dim vQtdServ(1 To 20) As Integer
  35.     Dim vValTotal(1 To 20) As Currency
  36.     Dim vCont As Integer
  37.     Dim vDescTemp As String
  38.     Dim vValTemp As Currency
  39.     Dim vServicoNF(1 To 20) As String
  40.     Dim vDiscriminacaoNF(1 To 20) As String
  41.     Dim vQtdServNF(1 To 20) As Integer
  42.     Dim vValTotalNF(1 To 20) As Currency
  43.     Dim vContNF As Integer
  44.  
  45.     'tabela de contas
  46.    Set Rec07 = Arquivo.OpenRecordset("select * from ger007")
  47.  
  48.     'comentado essa llinha para teste
  49.    'Rec16.MoveFirst
  50.    
  51.     objPrinter.ScaleMode = vbMillimeters
  52.  
  53.     For a = 0 To ConRec.gridFaturas.SelBookmarks.Count - 1
  54.    
  55.         vContMA = 0
  56.         vContDesc = 0
  57.         vContSCM = 0
  58.         vContSCM2 = 0
  59.         vContPC = 0
  60.         vValDesc = 0
  61.         vValMA = 0
  62.         vValSCM = 0
  63.         vValSCM2 = 0
  64.         vValPC = 0
  65.         Erase vServico
  66.         Erase vDiscriminacao
  67.         Erase vQtdServ
  68.         Erase vValTotal
  69.         Erase vServicoNF
  70.         Erase vDiscriminacaoNF
  71.         Erase vQtdServNF
  72.         Erase vValTotalNF
  73.         vCont = 0
  74.         vDescTemp = 0
  75.         vValTemp = 0
  76.         vContNF = 0
  77.        
  78.        
  79.     'Do While Not Rec16.EOF      ' loop p/ Imprimir todo o conteúdo
  80.    
  81.         With ConRec
  82.        
  83.        
  84.         'Inicio de Cabeçalho
  85.        
  86.         pag = False
  87.         NovaPag  'função que inicia a pagina
  88.        
  89.         Call Conectar_MYSQL
  90.        
  91.        
  92.         .dadosFaturas.Recordset.Bookmark = .gridFaturas.SelBookmarks(a)
  93.        
  94.         Call Conectar_MYSQL
  95.        
  96.         Set Rec16 = New ADODB.Recordset
  97.         Rec16.Open "SELECT * FROM conrec WHERE controle = " & .dadosFaturas.Recordset!controle, ConMysql, adOpenStatic, adLockReadOnly
  98.        
  99.         Set Rec15 = New ADODB.Recordset
  100.         Rec15.Open "SELECT * FROM cadcli WHERE codigo = '" & Rec16!credor & "'", ConMysql, adOpenStatic, adLockReadOnly
  101.        
  102.         Call Conectar_MYSQLServer(DadosConexaoServidores("ipdb"), DadosConexaoServidores("userdb"), DadosConexaoServidores("senhadb"), DadosConexaoServidores("nomedb"))
  103.        
  104.         Set Rec56 = New ADODB.Recordset
  105.         Rec56.Open "SELECT * FROM planos WHERE codigo = '" & Rec15!plano & "'", ConMysqlServer, adOpenStatic, adLockReadOnly
  106.        
  107.         ' Carregar a data de vencimento 30/03/2015
  108.        If ConRec.gridFaturas.SelBookmarks.Count >= 1 Then
  109.            
  110.             If NaoNull(Rec16!novadata) <> "" Then
  111.                
  112.                 vDataVenc = Rec16!novadata
  113.                
  114.             Else
  115.                
  116.                 vDataVenc = Rec16!Data
  117.                
  118.             End If
  119.  
  120.         End If
  121.            
  122.         If Rec16!pagamento = "P" Then
  123.             vValorBoleto = Rec16!valorpagto
  124.           Else
  125.             vValorBoleto = Format(Int((Rec16!atualizado + Redond(Rec16!multa) + Redond(Rec16!juros)) * 100) / 100, "Currency")
  126.         End If
  127.  
  128.                
  129.         If Not IsNull(Rec15!contacob) And Rec15!contacob <> Empty Then
  130.            
  131.             'buscando as informações da contacob do cliente
  132.            Rec07.FindFirst "codigo='" & Rec15!contacob & "'"
  133.            
  134.           Else
  135.          
  136.             'buscando as informações da contacob do cliente
  137.            Rec07.FindFirst "codigo='" & DadosEmpresa("codcontacob") & "'"
  138.                    
  139.          
  140.         End If
  141.        
  142.         If ConRec.dadosFaturas.Recordset!Banco = Rec07!Banco Then
  143.                
  144.             vConta = Rec07!conta
  145.             vDigConta = Rec07!digconta
  146.             vAgencia = Format(Rec07!agencia, "0000")
  147.             vDigAgencia = NaoNull(Rec07!digagencia)
  148.             vBanco = Rec07!Banco
  149.             vCodConvenio = Rec07!CodConvenio
  150.             vCarteira = Rec07!carteira
  151.                
  152.           Else
  153.              
  154.             vConta = ConRec.dadosFaturas.Recordset!conta
  155.             vDigConta = ConRec.dadosFaturas.Recordset!digconta
  156.             vAgencia = Format(ConRec.dadosFaturas.Recordset!codagencia, "0000")
  157.             vDigAgencia = NaoNull(ConRec.dadosFaturas.Recordset!digagencia)
  158.             vBanco = ConRec.dadosFaturas.Recordset!Banco
  159.             vCodConvenio = ConRec.dadosFaturas.Recordset!CodConvenio
  160.             vCarteira = ConRec.dadosFaturas.Recordset!carteira
  161.              
  162.         End If
  163.                                              
  164.         'Verifica se é preciso imprimir nota fiscal para o cliente
  165.        If Rec16!NumNota <> Empty Then
  166.                                                
  167.             If ConRec.vBoleto = False Then
  168.                                                
  169.                 Call AumentaItensNF
  170.                                                                
  171.               Else
  172.                                                
  173.                 If Existe(LogoEmpresa) Then
  174.                     ImprFoto LogoEmpresa, 6, 13, 38, 16.5
  175.                 End If
  176.              
  177.                 'repartições verticais
  178.                
  179.                 Lin vbBlack, 1.2, vbSolid, 10, 10, 35, 10
  180.                 Lin vbBlack, 1.2, vbSolid, 10, 140, 35, 140
  181.                 Lin vbBlack, 1.2, vbSolid, 10, 200, 35, 200
  182.                 Lin vbBlack, 1.2, vbSolid, 36, 10, 63, 10
  183.                 Lin vbBlack, 1.2, vbSolid, 36, 200, 63, 200
  184.                 Lin vbBlack, 1.2, vbSolid, 64, 10, 113, 10
  185.                 Lin vbBlack, 1.2, vbSolid, 64, 125, 113, 125
  186.                 Lin vbBlack, 1.2, vbSolid, 64, 200, 113, 200
  187.                 Lin vbBlack, 1.2, vbSolid, 115, 10, 123, 10
  188.                 Lin vbBlack, 1.2, vbSolid, 115, 73, 123, 73
  189.                 Lin vbBlack, 1.2, vbSolid, 115, 98, 123, 98
  190.                 Lin vbBlack, 1.2, vbSolid, 115, 135, 123, 135
  191.                 Lin vbBlack, 1.2, vbSolid, 115, 200, 123, 200
  192.                 Lin vbBlack, 1.2, vbSolid, 125, 10, 133, 10
  193.                 Lin vbBlack, 1.2, vbSolid, 125, 90, 133, 90
  194.                  
  195.                 'cabeçalho
  196.                
  197.                 Say "Nota Fiscal de Serviço de Comunicação", "Times New Roman", 10, True, False, False, 2, vbBlack, True, 0, 3
  198.                 Say "Modelo 21", "Times New Roman", 10, True, False, False, 2, vbBlack, True, 0, 6
  199.                
  200.                 'repartições horizontais
  201.                Lin vbBlack, 1.2, vbSolid, 10, 10, 10, 200
  202.                                  
  203.                 Call CabecalhoNF
  204.                
  205.                 'repartições horizontais
  206.                Lin vbBlack, 1.2, vbSolid, 35, 10, 35, 200
  207.                                      
  208.                 'repartições horizontais
  209.                Lin vbBlack, 1.2, vbSolid, 36, 10, 36, 200
  210.                                      
  211.                 Say "USUÁRIO: " & Rec15!Nome, "Times New Roman", 10, False, False, False, 1, vbBlack, True, 12.5, 0
  212.                 Say "ENDEREÇO: " & Rec15!endereco, "Times New Roman", 10, False, False, False, 1, vbBlack, True, 12.5, 0
  213.                 Say "BAIRRO: " & Rec15!bairro, "Times New Roman", 10, False, False, False, 1, vbBlack, True, 122.5, 39
  214.                 Say "", "Times New Roman", 2, False, False, False, 1, vbBlack, True, 0, 0
  215.                 Say "MUNICÍPIO: " & Rec15!ciddescr, "Times New Roman", 10, False, False, False, 1, vbBlack, True, 12.5, 0
  216.                 Say "CEP: " & Format(Rec15!Cep, "@@@@@-@@@"), "Times New Roman", 10, False, False, False, 1, vbBlack, False, 122.5, 43
  217.                 Say "UF: " & Rec15!estado, "Times New Roman", 10, False, False, False, 1, vbBlack, True, 162.5, 43
  218.                 Say "", "Times New Roman", 2, False, False, False, 1, vbBlack, True, 0, 0
  219.                 If Len(Rec15!cgc) = 14 Then
  220.                     Say "CNPJ: " & Format(Rec15!cgc, "000 000 000/0000-00"), "Times New Roman", 10, False, False, False, 1, vbBlack, True, 12.5, 0
  221.                     If Rec15!ie = Empty Or IsNull(Rec15!ie) Then
  222.                         Say "INSCRI. ESTADUAL: ISENTO", "Times New Roman", 10, False, False, False, 1, vbBlack, True, 12.5, 0
  223.                       Else
  224.                         Say "INSCRI. ESTADUAL: " & Rec15!ie, "Times New Roman", 10, False, False, False, 1, vbBlack, True, 12.5, 0
  225.                     End If
  226.                   Else
  227.                     Say "CPF: " & Format(Rec15!cgc, "000 000 000-00"), "Times New Roman", 10, False, False, False, 1, vbBlack, True, 12.5, 0
  228.                     Say "RG: " & Rec15!ie, "Times New Roman", 10, False, False, False, 1, vbBlack, True, 12.5, 0
  229.                 End If
  230.                 Say "TELEFONE/FAX: " & Rec15!telefone1 & " / " & Rec15!telefone2, "Times New Roman", 10, False, False, False, 1, vbBlack, True, 12.5, 0
  231.    
  232.                 'repartições horizontais
  233.                Lin vbBlack, 1.2, vbSolid, 63, 10, 63, 200
  234.                
  235.                 'repartições horizontais
  236.                Lin vbBlack, 1.2, vbSolid, 64, 10, 64, 200
  237.                
  238.                 Say "DESCRIMINAÇÃO DO SERVIÇO", "Times New Roman", 10, True, False, False, 1, vbBlack, False, 40, 0
  239.                 Say "VALOR", "Times New Roman", 10, True, False, False, 1, vbBlack, True, 150, 0
  240.                
  241.                 'repartições horizontais
  242.                Lin vbBlack, 1.2, vbSolid, 69, 10, 69, 200
  243.                
  244.                 Call Conectar_MYSQL
  245.                
  246.                 'descrições de lançamentos
  247.                Set Rec57 = New ADODB.Recordset
  248.                 Rec57.Open "SELECT * FROM mjconrec WHERE fatura = '" & Rec16!fatura & "'", ConMysql, adOpenStatic, adLockReadOnly
  249.                
  250.                 If Rec57.RecordCount > 0 Then
  251.                     Say "SERVIÇO DE PROVEDOR DE ACESSO", "Times New Roman", 10, False, False, False, 1, vbBlack, True, 12.5, 0
  252.                     Do While Not Rec57.EOF
  253.                  
  254.                         If Rec57!descricao = "Ref. ao Valor do SCM" Then
  255.                             vContSCM2 = vContSCM2 + 1
  256.                             vValSCM2 = vValSCM2 + Rec57!valor
  257.                         End If
  258.            
  259.                         Rec57.MoveNext
  260.                     Loop
  261.                    
  262.                    
  263.                     ''''''''''''''''''''''''Exibe as discriminações dos serviços na nota fiscal'''''''''''''''''''
  264.  
  265.                     Call Conectar_MYSQL
  266.  
  267.                     Set Rec57 = New ADODB.Recordset
  268.                     Rec57.Open "SELECT * FROM mjconrec WHERE fatura = '" & Rec16!fatura & "' ORDER BY valor DESC", ConMysql, adOpenStatic, adLockReadOnly
  269.  
  270.                     vCont = 1
  271.                    
  272.                     vServico(1) = Rec57!descricao
  273.                    
  274.                     Do While Not Rec57.EOF
  275.                        
  276.                          If Rec57!descricao = "Ref. ao Valor do SCM" Then
  277.                            
  278.                             Do While Not Rec57.EOF
  279.                                
  280.                                 If Not Rec57.EOF And Rec57!descricao = "Ref. ao Valor do SCM" Then
  281.                                
  282.                                     Rec57.MoveNext
  283.                                
  284.                                 Else
  285.                                
  286.                                     Exit Do
  287.                                
  288.                                 End If
  289.                                
  290.                             Loop
  291.                            
  292.                          End If
  293.                          
  294.                          If Rec57.EOF Then Exit Do
  295.                                                      
  296.                          If Rec57!descricao = vServico(vCont) Then
  297.                          
  298.                              vQtdServ(vCont) = vQtdServ(vCont) + 1
  299.                              vValTotal(vCont) = vValTotal(vCont) + Rec57!valor
  300.                              vDiscriminacao(vCont) = NaoNull(Rec57!Discriminacao)
  301.                                
  302.                          Else
  303.                          
  304.                             vCont = vCont + 1
  305.                             vServico(vCont) = Rec57!descricao
  306.                             vQtdServ(vCont) = vQtdServ(vCont) + 1
  307.                             vValTotal(vCont) = vValTotal(vCont) + Rec57!valor
  308.                             vDiscriminacao(vCont) = NaoNull(Rec57!Discriminacao)
  309.                            
  310.                          End If
  311.                          
  312.                          Rec57.MoveNext
  313.                          
  314.                     Loop
  315.                    
  316.                     Dim vDesconto As Integer
  317.                     Dim b As Integer
  318.                    
  319.                    
  320.                     For b = 1 To vCont
  321.                        
  322.                         If vValTotal(b) < 0 Then
  323.                            
  324.                             vDesconto = b
  325.                             If b < vCont Then b = b + 1
  326.                            
  327.                             GoTo continue
  328.                            
  329.                         End If
  330.                        
  331.                         Say vQtdServ(b) & Space(2) & vServico(b), "Times New Roman", 10, True, False, False, 1, vbBlack, False, 12.5, 0
  332.                         Say Format(vValTotal(b), "Currency"), "Times New Roman", 10, False, False, False, 1, vbBlack, True, 150, 0
  333.                    
  334.                         If NaoNull(vDiscriminacao(b)) <> "" Then
  335.                        
  336.                             Say Chr(9) & QuebraLinha(vDiscriminacao(b), 55, 1), "Times New Roman", 10, False, False, False, 1, vbBlack, True, 12.5, 0
  337.                             Say Chr(9) & QuebraLinha(vDiscriminacao(b), 55, 2), "Times New Roman", 10, False, False, False, 1, vbBlack, True, 12.5, 0
  338.                             Say Chr(9) & QuebraLinha(vDiscriminacao(b), 55, 3), "Times New Roman", 10, False, False, False, 1, vbBlack, True, 12.5, 0
  339.                            
  340.                         End If
  341. continue:
  342.                        
  343.                     Next
  344.  
  345.  
  346.                     If vContSCM2 > 0 Then
  347.                           Say "SERVIÇO DE COMUNICAÇÃO MULTIMIDIA", "Times New Roman", 10, False, False, False, 1, vbBlack, False, 12.5, 0
  348.                           Say Format(vValSCM2, "Currency"), "Times New Roman", 10, False, False, False, 1, vbBlack, True, 150, 0
  349.                     End If
  350.                    
  351.                    
  352.                     If vDesconto > 0 Then
  353.                    
  354.                         If vValTotal(vDesconto) <> 0 Then
  355.                        
  356.                            Say vServico(vDesconto), "Times New Roman", 10, True, False, False, 1, vbBlack, False, 12.5, 0
  357.                            Say Format(vValTotal(vDesconto), "Currency"), "Times New Roman", 10, False, False, False, 1, vbBlack, True, 150, 0
  358.                            
  359.                         End If
  360.                        
  361.                     End If
  362.                    
  363.                 End If
  364.                
  365.              
  366.                
  367.                 'repartições horizontais
  368.                Lin vbBlack, 1.2, vbSolid, 73, 10, 73, 200
  369.    
  370.                 'repartições horizontais
  371.                Lin vbBlack, 1.2, vbSolid, 77, 10, 77, 200
  372.    
  373.                 'repartições horizontais
  374.                Lin vbBlack, 1.2, vbSolid, 81, 10, 81, 200
  375.    
  376.                 'repartições horizontais
  377.                Lin vbBlack, 1.2, vbSolid, 85, 10, 85, 200
  378.    
  379.                 'repartições horizontais
  380.                Lin vbBlack, 1.2, vbSolid, 89, 10, 89, 200
  381.    
  382.                 'repartições horizontais
  383.                Lin vbBlack, 1.2, vbSolid, 93, 10, 93, 200
  384.    
  385.                 'repartições horizontais
  386.                Lin vbBlack, 1.2, vbSolid, 97, 10, 97, 200
  387.                
  388.                 'repartições horizontais
  389.                Lin vbBlack, 1.2, vbSolid, 101, 10, 101, 200
  390.                                
  391.                 'repartições horizontais
  392.                Lin vbBlack, 1.2, vbSolid, 105, 10, 105, 200
  393.                                
  394.                 'repartições horizontais
  395.                Lin vbBlack, 1.2, vbSolid, 109, 10, 109, 200
  396.                
  397.                 Say "Valor aproximado dos Tributos Federais: 13,45% e Municipais: 2,00%", "Times New Roman", 10, False, False, False, 1, vbBlack, False, 13, 105
  398.                 Say "FONTE: IBPT Chave " & DadosEmpresa("chave_ibpt") & ".", "Times New Roman", 10, False, False, False, 1, vbBlack, False, 13, 109
  399.                 Say "TOTAL  " & Format(Int(Rec16!valornf * 100) / 100, "Currency"), "Times New Roman", 10, True, False, False, 1, vbBlack, False, 150, 109
  400.                
  401.                 'repartições horizontais
  402.                Lin vbBlack, 1.2, vbSolid, 113, 10, 113, 200
  403.                                
  404.                 'repartições horizontais
  405.                Lin vbBlack, 1.2, vbSolid, 115, 10, 115, 200
  406.                                
  407.                 Say "BASE DE CÁLCULO DO ICMS", "Times New Roman", 10, True, False, False, 1, vbBlack, False, 12.5, 0
  408.                 Say "ALÍQUOTA", "Times New Roman", 10, True, False, False, 1, vbBlack, False, 75, 0
  409.                 Say "VALOR DO ICMS", "Times New Roman", 10, True, False, False, 1, vbBlack, False, 100, 0
  410.                 Say "DATA OU PERÍODO DA PRESTAÇÃO", "Times New Roman", 10, True, False, False, 1, vbBlack, True, 137, 0
  411.                 Say Format(Val(Rec16!basecalcicms) / 100, "Currency"), "Times New Roman", 10, False, False, False, 1, vbBlack, False, 12.5, 0
  412.                 If Val(Rec16!valicms) > 0 Then
  413.                     Say DadosEmpresa("aliquotaicms") & " %", "Times New Roman", 10, False, False, False, 1, vbBlack, False, 75, 0
  414.                   Else
  415.                     Say "0 %", "Times New Roman", 10, False, False, False, 1, vbBlack, False, 75, 0
  416.                 End If
  417.                 Say Format(Val(Rec16!valicms) / 100, "Currency"), "Times New Roman", 10, False, False, False, 1, vbBlack, False, 100, 0
  418.                
  419.                 'verificando a data de emissao da nota fiscal
  420.                If Rec16!datanf <> Empty Or Not IsNull(Rec16!datanf) Then
  421.                     If Rec16!datanf > Rec16!emissao Then
  422.                         Say Format(Rec16!datanf, "dd/mm/yyyy"), "Times New Roman", 10, False, False, False, 1, vbBlack, True, 137, 0
  423.                       Else
  424.                         Say Format(Rec16!emissao, "dd/mm/yyyy"), "Times New Roman", 10, False, False, False, 1, vbBlack, True, 137, 0
  425.                     End If
  426.                   Else
  427.                     Say Format(Rec16!emissao, "dd/mm/yyyy"), "Times New Roman", 10, False, False, False, 1, vbBlack, True, 137, 0
  428.                 End If
  429.                
  430.                 'repartições horizontais
  431.                Lin vbBlack, 1.2, vbSolid, 123, 10, 123, 200
  432.                
  433.                 'repartições horizontais
  434.                Lin vbBlack, 1.2, vbSolid, 125, 10, 125, 90
  435.                                                
  436.                 If DadosEmpresa("reduzbcicms") = "True" And Rec16!reduz = 1 Then
  437.                     Say "RESERVADO AO FISCO", "Times New Roman", 10, True, False, False, 1, vbBlack, False, 12.5, 0
  438.                     Say "B.C reduzida de acordo com o artigo 23 do anexo III do RICMS", "Times New Roman", 8, False, False, False, 1, vbBlack, True, 91, 0
  439.                     Say Mid(Rec16!md5hash, 1, 4) & "." & Mid(Rec16!md5hash, 5, 4) & "." & Mid(Rec16!md5hash, 9, 4) & "." & Mid(Rec16!md5hash, 13, 4) & "." & Mid(Rec16!md5hash, 17, 4) & "." & Mid(Rec16!md5hash, 21, 4) & "." & Mid(Rec16!md5hash, 25, 4) & "." & Mid(Rec16!md5hash, 29, 4), "Times New Roman", 10, False, False, False, 1, vbBlack, False, 12.5, 0
  440.                     Say "          (lei 6.374/89 art 112, red. pelo art. 1° do decreto 47.584 de 10/01/2003)", "Times New Roman", 6, False, False, False, 1, vbBlack, True, 91, 0
  441.                     Say "Este documento não vale como recibo, só será válido com autenticação ou extrato de conta", "Times New Roman", 8, False, False, False, 1, vbBlack, True, 91, 0
  442.                 ElseIf DadosEmpresa("optsimples") Then
  443.                     Say "RESERVADO AO FISCO", "Times New Roman", 10, True, False, False, 1, vbBlack, False, 12.5, 0
  444.                     Say "I  - Documento emitido por ME ou EPP optante do Simples Nacional ", "Times New Roman", 8, False, False, False, 1, vbBlack, True, 91, 0
  445.                     Say "II - Não gera direito a crédito fiscal de IPI", "Times New Roman", 8, False, False, False, 1, vbBlack, True, 91, 0
  446.                     Say Mid(Rec16!md5hash, 1, 4) & "." & Mid(Rec16!md5hash, 5, 4) & "." & Mid(Rec16!md5hash, 9, 4) & "." & Mid(Rec16!md5hash, 13, 4) & "." & Mid(Rec16!md5hash, 17, 4) & "." & Mid(Rec16!md5hash, 21, 4) & "." & Mid(Rec16!md5hash, 25, 4) & "." & Mid(Rec16!md5hash, 29, 4), "Times New Roman", 10, False, False, False, 1, vbBlack, False, 12.5, 0
  447.                     Say "Este documento não vale como recibo, só será válido com autenticação ou extrato de conta", "Times New Roman", 8, False, False, False, 1, vbBlack, True, 91, 0
  448.                 Else
  449.                     Say "RESERVADO AO FISCO", "Times New Roman", 10, True, False, False, 1, vbBlack, True, 12.5, 0
  450.                     Say Mid(Rec16!md5hash, 1, 4) & "." & Mid(Rec16!md5hash, 5, 4) & "." & Mid(Rec16!md5hash, 9, 4) & "." & Mid(Rec16!md5hash, 13, 4) & "." & Mid(Rec16!md5hash, 17, 4) & "." & Mid(Rec16!md5hash, 21, 4) & "." & Mid(Rec16!md5hash, 25, 4) & "." & Mid(Rec16!md5hash, 29, 4), "Times New Roman", 10, False, False, False, 1, vbBlack, False, 12.5, 0
  451.                     Say "Este documento não vale como recibo, só será válido com autenticação ou extrato de conta", "Times New Roman", 8, False, False, False, 1, vbBlack, True, 91, 0
  452.                 End If
  453.                
  454.                 'repartições horizontais
  455.                Lin vbBlack, 1.2, vbSolid, 133, 10, 133, 90
  456.                
  457.                 'Say "", "Times New Roman", 8, True, False, False, 1, vbBlack, True, 10, 0
  458.                
  459.             End If
  460.                    
  461.         Else
  462.                        
  463.             If Existe(LogoEmpresa) Then
  464.                 ImprFoto LogoEmpresa, 4, 3, 51, 23
  465.             End If
  466.                        
  467.             objPrinter.PaintPicture LogoBB.Picture, 155, 3, LogoBB.Width / 56.7, LogoBB.Height / 56.7
  468.    
  469.             'cabeçalho
  470.            Say DadosEmpresa("nome"), "Times New Roman", 14, True, False, False, 2, vbBlack, True, 0, 3
  471.             Say DadosEmpresa("endereco") & " - " & DadosEmpresa("bairro"), "Times New Roman", 12, True, False, False, 2, vbBlack, True, 0, 0
  472.             Say Format(DadosEmpresa("cep"), "@@@@@-@@@") & " - " & DadosEmpresa("cidade") & " - " & DadosEmpresa("estado"), "Times New Roman", 12, True, False, False, 2, vbBlack, True, 0, 0
  473.             Say "Informações: " & DadosEmpresa("telefone1") & " - " & DadosEmpresa("email"), "Times New Roman", 12, True, False, False, 2, vbBlack, True, 0, 0
  474.             Say DadosEmpresa("site"), "Times New Roman", 12, True, False, False, 2, vbBlack, True, 0, 0
  475.            
  476.             Justifica Rec07!msgconta, "Arial", 8, True, False, False, 1, vbBlack, 11, 50
  477.            
  478.             Dim vMsgJuros As String
  479.        
  480.             If SCAOption("Multa") = 1 And Val(DadosEmpresa("ValMulta")) > 0 Then
  481.                
  482.                 vMsgJuros = "Após vencimento, cobrar " & DadosEmpresa("ValMulta") & "% de multa"
  483.            
  484.             End If
  485.            
  486.             If SCAOption("Atualiza") = 1 And Val(DadosEmpresa("taxa")) > 0 Then
  487.            
  488.                 vMsgJuros = vMsgJuros & " e " & DadosEmpresa("taxa") & "% de juros ao mês."
  489.             Else
  490.            
  491.                 vMsgJuros = vMsgJuros & "."
  492.            
  493.             End If
  494.            
  495.             If vMsgJuros <> "" Then
  496.        
  497.                 Justifica vMsgJuros, "Arial", 8, True, False, False, 1, vbBlack, 11, 100
  498.        
  499.             End If
  500.            
  501.            
  502.             If Rec16!juros > 0 And Rec16!multa > 0 Then
  503.            
  504.                 Justifica "  Valor de Juros e Multa: " & "R$" & Redond(Rec16!juros + Rec16!multa), "Arial", 8, True, False, False, 1, vbBlack, 11, 119
  505.            
  506.             End If
  507.  
  508.             Call Conectar_MYSQL
  509.  
  510.             Set RecATZ = New ADODB.Recordset
  511.             RecATZ.Open "SELECT * FROM conrec WHERE credor = '" & Rec16!credor & "' AND data < '" & Format(Date, "YYYY-MM-DD") & "' AND ISNULL(pagamento) ORDER BY data", ConMysql, adOpenStatic, adLockReadOnly
  512.            
  513.             Dim vImpMens As Boolean
  514.             vImpMens = False
  515.            
  516.             If RecATZ.RecordCount > 0 Then
  517.            
  518.                 Do While Not RecATZ.EOF
  519.                
  520.                     If RecATZ!fatura <> Rec16!fatura And (RecATZ!Data - Date) > 15 Then
  521.                         vImpMens = True
  522.                     End If
  523.                    
  524.                     RecATZ.MoveNext
  525.                    
  526.                 Loop
  527.                
  528.             End If
  529.            
  530.             If vImpMens Then
  531.            
  532.                 Justifica DadosEmpresa("msgAtrazo"), "Arial", 10, True, False, False, 1, vbBlack, 11, 80
  533.            
  534.             End If
  535.            
  536.         End If
  537.        
  538.         If SCAOption("Multa") = 1 And Val(DadosEmpresa("ValMulta")) > 0 Then
  539.                
  540.             vMsgJuros = "Após vencimento, cobrar " & DadosEmpresa("ValMulta") & "% de multa"
  541.        
  542.         End If
  543.        
  544.         If SCAOption("Atualiza") = 1 And Val(DadosEmpresa("taxa")) > 0 Then
  545.        
  546.             vMsgJuros = vMsgJuros & " e " & DadosEmpresa("taxa") & "% de juros ao mês."
  547.        
  548.         Else
  549.        
  550.             vMsgJuros = vMsgJuros & "."
  551.        
  552.         End If
  553.        
  554.         If vMsgJuros <> "" Then
  555.        
  556.             Justifica vMsgJuros, "Arial", 8, True, False, False, 1, vbBlack, 13, 235
  557.        
  558.         End If
  559.        
  560.         Justifica "Após vencimento, sujeito à suspensão dos serviços e posterior envio aos ", "Arial", 8, True, False, False, 1, vbBlack, 13, 238
  561.         Justifica "órgãos de cobrança, conforme prazos contratuais.", "Arial", 8, True, False, False, 1, vbBlack, 13, 243
  562.        
  563.         Justifica DadosEmpresa("msgivr"), "Arial", 8, True, False, False, 1, vbBlack, 13, 248
  564.         Justifica "Central de Atendimento da Anatel - 1331", "Arial", 8, True, False, False, 1, vbBlack, 13, 252
  565.        
  566.         'verificando se é necessário imprimir o boleto
  567.        If ConRec.vBoleto = True Then
  568.  
  569.             Lin vbBlack, 1.2, vbSolid, 138, 10, 138, 200
  570.                    
  571.             Say "Demonstrativo de Cobrança", "Arial", 8, True, False, False, 1, vbBlack, False, 10, 139.5
  572.             Say "Recibo do Sacado", "Arial", 12, True, False, False, 3, vbBlack, False, 10, 138.5
  573.            
  574.             Lin vbBlack, 1.2, vbSolid, 144, 10, 144, 200
  575.             Lin vbBlack, 1.2, vbSolid, 144, 10, 171.5, 10
  576.             Lin vbBlack, 1.2, vbSolid, 144, 200, 171.5, 200
  577.             Lin vbBlack, 1.2, vbSolid, 171.5, 10, 171.5, 200
  578.             Lin vbBlack, 1.2, vbSolid, 148, 10, 148, 105
  579.             Lin vbBlack, 1.2, vbSolid, 144, 105, 171.5, 105
  580.             Lin vbBlack, 1.2, vbSolid, 151, 105, 151, 200
  581.             Lin vbBlack, 1.2, vbSolid, 158, 105, 158, 200
  582.             Lin vbBlack, 1.2, vbSolid, 165, 105, 165, 200
  583.            
  584.             'repartições menores em vertical
  585.            Lin vbBlack, 1.2, vbSolid, 144, 170, 151, 170
  586.             Lin vbBlack, 1.2, vbSolid, 158, 124, 165, 124
  587.             Lin vbBlack, 1.2, vbSolid, 158, 151, 165, 151
  588.             Lin vbBlack, 1.2, vbSolid, 158, 179, 165, 179
  589.             Lin vbBlack, 1.2, vbSolid, 165, 151, 171.5, 151
  590.            
  591.             If Rec16!NumNota = Empty Then Say "Instruções :", "Arial", 8, False, False, False, 1, vbBlack, False, 10.5, 108
  592.             Say "Descrição", "Arial", 8, False, False, False, 1, vbBlack, False, 10.5, 144
  593.             Say "Cedente", "Arial", 8, False, False, False, 1, vbBlack, False, 105.5, 144
  594.             Say "Agência / Cód.Cedente", "Arial", 8, False, False, False, 1, vbBlack, False, 170.5, 144
  595.             Say "Cliente", "Arial", 8, False, False, False, 1, vbBlack, False, 105.5, 151
  596.             Say "Data Emissão", "Arial", 8, False, False, False, 1, vbBlack, False, 105.5, 158
  597.             Say "Nosso Número", "Arial", 8, False, False, False, 1, vbBlack, False, 124.5, 158
  598.             Say "Número Documento", "Arial", 8, False, False, False, 1, vbBlack, False, 151.5, 158
  599.             Say "Mês de Fatura", "Arial", 8, False, False, False, 1, vbBlack, False, 179.5, 158
  600.             Say "Vencimento", "Arial", 8, False, False, False, 1, vbBlack, False, 105.5, 165
  601.             Say "Valor", "Arial", 8, False, False, False, 1, vbBlack, False, 151.5, 165
  602.            
  603.            
  604.             Say "Autenticação Mecânica", "Arial", 8, False, False, False, 1, vbBlack, False, 135, 172
  605.            
  606.             'picote
  607.            Lin vbBlack, 1.2, vbDot, 183, 10, 183, 200
  608.            
  609.            
  610.             'segunda parte
  611.            'objPrinter.PaintPicture LogoBB2.Picture,  3,  185.88, LogoBB2.Width / 56.7, LogoBB2.Height / 56.7
  612.            objPrinter.PaintPicture LogoBB2.Picture, 5, 183.88, LogoBB2.Width / 56.7, LogoBB2.Height / 56.7
  613.                            
  614.             Lin vbBlack, 1.2, vbSolid, 188, 64, 195.14, 64
  615.             Lin vbBlack, 1.2, vbSolid, 188, 80, 195.14, 80
  616.            
  617.             Say "237-2", "Arial", 14, True, False, False, 1, vbBlack, False, 65, 189
  618.            
  619.             'quadrado
  620.            Lin vbBlack, 1.2, vbSolid, 195.14, 10, 195.14, 200
  621.             Lin vbBlack, 1.2, vbSolid, 195.14, 10, 269.14, 10
  622.             Lin vbBlack, 1.2, vbSolid, 195.14, 200, 269.14, 200
  623.             Lin vbBlack, 1.2, vbSolid, 269.14, 10, 269.14, 200
  624.            
  625.             'repartições horizontais
  626.            Lin vbBlack, 1.2, vbSolid, 203.14, 10, 203.14, 200
  627.             Lin vbBlack, 1.2, vbSolid, 210.14, 10, 210.14, 200
  628.             Lin vbBlack, 1.2, vbSolid, 217.14, 10, 217.14, 200
  629.             Lin vbBlack, 1.2, vbSolid, 224.14, 10, 224.14, 200
  630.             Lin vbBlack, 1.2, vbSolid, 231.14, 121, 231.14, 200
  631.             Lin vbBlack, 1.2, vbSolid, 237.14, 121, 237.14, 200
  632.             Lin vbBlack, 1.2, vbSolid, 244.14, 121, 244.14, 200
  633.             Lin vbBlack, 1.2, vbSolid, 250.64, 121, 250.64, 200
  634.             Lin vbBlack, 1.2, vbSolid, 256.5, 10, 256.5, 200
  635.            
  636.             'repartições verticais
  637.            Lin vbBlack, 1.2, vbSolid, 210.14, 36.5, 217.14, 36.5
  638.             Lin vbBlack, 1.2, vbSolid, 210.14, 64, 217.14, 64
  639.             Lin vbBlack, 1.2, vbSolid, 210.14, 83.5, 217.14, 83.5
  640.             Lin vbBlack, 1.2, vbSolid, 210.14, 93, 217.14, 93
  641.             Lin vbBlack, 1.2, vbSolid, 195.14, 121, 256.5, 121
  642.             'Lin vbBlack, 1.2, vbSolid, 217.14, 36, 224.14, 36
  643.            Lin vbBlack, 1.2, vbSolid, 217.14, 36.5, 224.14, 36.5
  644.             Lin vbBlack, 1.2, vbSolid, 217.14, 29.5, 224.14, 29.5
  645.             Lin vbBlack, 1.2, vbSolid, 217.14, 53, 224.14, 53
  646.             Lin vbBlack, 1.2, vbSolid, 217.14, 64, 224.14, 64
  647.             Lin vbBlack, 1.2, vbSolid, 217.14, 93, 224.14, 93
  648.             'Say "X", "Arial", 10, False, False, False, 1, vbBlack, False, 93, 219
  649.            Lin vbBlack, 1.2, vbSolid, 273.5, 125, 273.5, 200
  650.            
  651.             Say "Local de Pagamento", "Arial", 8, False, False, False, 1, vbBlack, False, 10.5, 195.14
  652.             Say "Vencimento", "Arial", 8, False, False, False, 1, vbBlack, False, 121.5, 195.14
  653.             Say "Cedente", "Arial", 8, False, False, False, 1, vbBlack, False, 10.5, 203.14
  654.             Say "Agência / Código do Cedente", "Arial", 8, False, False, False, 1, vbBlack, False, 121.5, 203.14
  655.             Say "Data de Emissão", "Arial", 8, False, False, False, 1, vbBlack, False, 10.5, 210.14
  656.             Say "Número Documento", "Arial", 8, False, False, False, 1, vbBlack, False, 37.5, 210.14
  657.             Say "Espécie Doc.", "Arial", 8, False, False, False, 1, vbBlack, False, 64.5, 210.14
  658.             Say "Aceite", "Arial", 8, False, False, False, 1, vbBlack, False, 84.3, 210.14
  659.             Say "Data Processamento", "Arial", 8, False, False, False, 1, vbBlack, False, 94, 210.14
  660.             Say "Carteira / Nosso Número", "Arial", 8, False, False, False, 1, vbBlack, False, 121.5, 210.14
  661.             'Say "Nº da Conta/Respo.", "Arial", 8, False, False, False, 1, vbBlack, False, 10.5, 217.34
  662.            'Say "Carteira", "Arial", 8, False, False, False, 1, vbBlack, False, 36.5, 217.34
  663.            Say "Uso do Banco", "Arial", 8, False, False, False, 1, vbBlack, False, 10.5, 217.34
  664.             Say "CIP", "Arial", 8, False, False, False, 1, vbBlack, False, 30.5, 217.34
  665.             Say "Carteira", "Arial", 8, False, False, False, 1, vbBlack, False, 37.5, 217.34
  666.             Say "Moeda", "Arial", 8, False, False, False, 1, vbBlack, False, 54.5, 217.34
  667.             Say "Quantidade", "Arial", 8, False, False, False, 1, vbBlack, False, 64.5, 217.34
  668.             Say "Valor", "Arial", 8, False, False, False, 1, vbBlack, False, 94, 217.34
  669.             Say "Valor do Documento", "Arial", 8, False, False, False, 1, vbBlack, False, 121.5, 217.34
  670.             Say "Instruções", "Arial", 8, False, False, False, 1, vbBlack, False, 10.5, 224.77
  671.             Say "(-)Desconto", "Arial", 8, False, False, False, 1, vbBlack, True, 121.5, 224.34
  672.             Say "(-)Outras Deduções", "Arial", 8, False, False, False, 1, vbBlack, True, 121.5, 231.34
  673.             Say "(+)Mora/Multa", "Arial", 8, False, False, False, 1, vbBlack, True, 121.5, 238.34
  674.             Say "(+)Outros Acréscimos", "Arial", 8, False, False, False, 1, vbBlack, True, 121.5, 245.34
  675.             Say "(=)Valor Cobrado", "Arial", 8, False, False, False, 1, vbBlack, False, 121.5, 251.14
  676.             Say "Sacado :", "Arial", 8, False, False, False, 1, vbBlack, False, 10.5, 256.64
  677.             If Rec16!NumNota = Empty Then Say "CNPJ/CPF :", "Arial", 8, False, False, False, 1, vbBlack, False, 140, 256.64
  678.             If Rec16!NumNota = Empty Then Say "Inscrição/RG :", "Arial", 8, False, False, False, 1, vbBlack, False, 140, 260
  679.             Say "Sacador/Avalista", "Arial", 8, False, False, False, 1, vbBlack, False, 10.5, 265.74
  680.             Say "Ficha de Compensação", "Arial", 12, True, False, False, 3, vbBlack, False, 10, 268.96
  681.             Say "Autenticação Mecânica", "Arial", 8, True, False, False, 1, vbBlack, False, 149.05, 274
  682.                    
  683.                    
  684.             '< ===================================== JUROS / MULTAS =========================================>
  685.            If Rec16!pagamento = "P" And Rec16!juros > 0 And Rec16!multa > 0 Then
  686.                
  687.                 Say Format(Redond(Rec16!juros) + Redond(Rec16!multa), "Currency"), "Arial", 14, True, False, False, 3, vbBlack, False, 13, 238.34
  688.                
  689.             End If
  690.            
  691.            
  692.             'Preencher Campos
  693.            
  694.             'Verifica se é preciso imprimir nota fiscal para o cliente
  695.            If Rec16!NumNota <> Empty Then
  696.                
  697.                     'montar nosso numero com um numero a esquerda para completar a quantidade de digitos
  698.                    vNossoNum = Rec16!fatura & "-" & NossoNumero(Rec16!fatura, Rec07!carteira)
  699.                    
  700.                     'Say Rec16!descricao, "Arial", 8, True, False, False, 1, vbBlack, False, 10.5, 148
  701.                    Say "", "Arial", 8, True, False, False, 1, vbBlack, True, 10.5, 0
  702.                     Say "", "Arial", 8, True, False, False, 1, vbBlack, True, 10.5, 145
  703.                    
  704.                     Call Conectar_MYSQL
  705.                    
  706.                     'descrições de lançamentos
  707.                    Set Rec57 = New ADODB.Recordset
  708.                     Rec57.Open "SELECT * FROM mjconrec where fatura = '" & Rec16!fatura & "' ORDER BY valor DESC", ConMysql, adOpenStatic, adLockReadOnly
  709.                    
  710.                     vContNF = 1
  711.                    
  712.                     vServicoNF(1) = Rec57!descricao
  713.                    
  714.                     Do While Not Rec57.EOF
  715.                        
  716.                          If Rec57!descricao = "Ref. ao Valor do SCM" Then
  717.                            
  718.                             Do While Not Rec57.EOF
  719.                                
  720.                                 If Not Rec57.EOF And Rec57!descricao = "Ref. ao Valor do SCM" Then
  721.                                
  722.                                     Rec57.MoveNext
  723.                                
  724.                                 Else
  725.                                
  726.                                     Exit Do
  727.                                
  728.                                 End If
  729.                                
  730.                             Loop
  731.                            
  732.                          End If
  733.                          
  734.                          If Rec57.EOF Then Exit Do
  735.                                                      
  736.                          If Rec57!descricao = vServicoNF(vContNF) Then
  737.                          
  738.                              vQtdServNF(vContNF) = vQtdServNF(vContNF) + 1
  739.                              vValTotalNF(vContNF) = vValTotalNF(vContNF) + Rec57!valor
  740.                              vDiscriminacaoNF(vContNF) = NaoNull(Rec57!Discriminacao)
  741.                                
  742.                          Else
  743.                          
  744.                             vContNF = vContNF + 1
  745.                             vServicoNF(vContNF) = Rec57!descricao
  746.                             vQtdServNF(vContNF) = vQtdServNF(vContNF) + 1
  747.                             vValTotalNF(vContNF) = vValTotalNF(vContNF) + Rec57!valor
  748.                             vDiscriminacaoNF(vContNF) = NaoNull(Rec57!Discriminacao)
  749.                            
  750.                          End If
  751.                          
  752.                          Rec57.MoveNext
  753.                          
  754.                     Loop
  755.                    
  756.                     '< ===========================================================||=========================================================>
  757.                    
  758.                     Dim vDescontoNF As Integer
  759.                     Dim c As Integer
  760.                    
  761.                         Say Rec16!descricao, "Arial", 8, True, False, False, 1, vbBlack, True, 12.5, 0
  762.                        
  763.                         For c = 1 To vContNF
  764.                        
  765.                             If vValTotalNF(c) < 0 Then
  766.                            
  767.                                 vDescontoNF = c
  768.                                 If c < vContNF Then c = c + 1
  769.                                
  770.                                 GoTo continue2
  771.                                
  772.                             End If
  773.                        
  774.                         'If Rec57!descricao <> "Desconto" And Rec57!descricao <> "Micros Adicionais na rede do cliente" And Rec57!descricao <> "Ref. ao Valor do SCM" And Rec57!descricao <> "Ref. ao Suporte do Plano Corp." Then
  775.                            Say vQtdServNF(c) & Space(2) & vServicoNF(c), "Arial", 8, True, False, False, 1, vbBlack, False, 13, 0
  776.                             Say Format(vValTotalNF(c), "Currency"), "Arial", 8, True, False, False, 3, vbBlack, True, 110, 0
  777.                         'End If
  778.                            
  779. continue2:
  780.                            
  781.                         Next
  782.                        
  783.                         Call Conectar_MYSQL
  784.                        
  785.                         Set Rec57 = New ADODB.Recordset
  786.                         Rec57.Open "SELECT * FROM mjconrec WHERE fatura = '" & Rec16!fatura & "'", ConMysql, adOpenStatic, adLockReadOnly
  787.                        
  788.                         If Rec57.RecordCount > 0 Then
  789.                            
  790.                             Do While Not Rec57.EOF
  791.                                
  792.                                 If Rec57!descricao = "Ref. ao Valor do SCM" Then
  793.                                     vContSCM = vContSCM + 1
  794.                                     vValSCM = vValSCM + Rec57!valor
  795.                                 End If
  796.                            
  797.                             Rec57.MoveNext
  798.                            
  799.                             Loop
  800.                            
  801.                             If vContSCM > 0 Then
  802.                                 Say vContSCM & " Ref. ao Valor do SCM", "Arial", 8, True, False, False, 1, vbBlack, False, 13, 0
  803.                                 Say Format(vValSCM, "Currency"), "Arial", 8, True, False, False, 3, vbBlack, True, 110, 0
  804.                             End If
  805.                        
  806.                          End If
  807.                        
  808.                         If vDescontoNF > 0 Then
  809.                        
  810.                             If vValTotalNF(vDescontoNF) <> 0 Then
  811.                                
  812.                                 Say vServicoNF(vDescontoNF), "Arial", 8, True, False, False, 1, vbBlack, False, 13, 0
  813.                                 Say Format(vValTotalNF(vDescontoNF), "Currency"), "Arial", 8, True, False, False, 3, vbBlack, True, 110, 0
  814.                            
  815.                             End If
  816.                            
  817.                         End If
  818.                    
  819.                     '< ===========================================================||=========================================================>
  820.  
  821.                     Say DadosEmpresa("razao"), "Arial", 8, True, False, False, 1, vbBlack, False, 105.5, 147
  822.                     Say vAgencia & "-" & vDigAgencia & " / " & vConta & "-" & vDigConta, "Arial", 8, True, False, False, 1, vbBlack, False, 171, 147
  823.                     Say Rec15!Codigo & "-" & Rec15!razao, "Arial", 8, True, False, False, 1, vbBlack, False, 105.5, 154
  824.                    
  825.                     'verificando a data de emissao da nota fiscal
  826.                    If Rec16!datanf <> Empty Or Not IsNull(Rec16!datanf) Then
  827.                         If Rec16!datanf > Rec16!emissao Then
  828.                             Say Format(Rec16!datanf, "dd/mm/yyyy"), "Arial", 8, True, False, False, 1, vbBlack, False, 105.5, 161
  829.                           Else
  830.                             Say Format(Rec16!emissao, "dd/mm/yyyy"), "Arial", 8, True, False, False, 1, vbBlack, False, 105.5, 161
  831.                         End If
  832.                       Else
  833.                         Say Format(Rec16!emissao, "dd/mm/yyyy"), "Arial", 8, True, False, False, 1, vbBlack, False, 105.5, 161
  834.                     End If
  835.                    
  836.                     Say vNossoNum, "Arial", 8, True, False, False, 1, vbBlack, False, 124.5, 161
  837.                     Say Rec16!fatura, "Arial", 8, True, False, False, 1, vbBlack, False, 151.5, 161
  838. '                    Say Format(Rec16!Data, "mm/yy"), "Arial", 8, True, False, False, 1, vbBlack, False, 180, 161
  839. '                    Say Format(Rec16!Data, "dd/mm/yyyy"), "Arial", 14, True, False, False, 1, vbBlack, False, 122, 165.5
  840.                    Say Format(vDataVenc, "mm/yy"), "Arial", 8, True, False, False, 1, vbBlack, False, 180, 161
  841.                     Say Format(vDataVenc, "dd/mm/yyyy"), "Arial", 14, True, False, False, 1, vbBlack, False, 122, 165.5
  842.                    
  843.                     '<================================== VALOR DO DOCUMENTO (SUPERIOR) ============================= >
  844.                    If Rec16!pagamento = "P" Then
  845.                    
  846.                         Say Format(Int((Rec16!atualizado) * 100) / 100, "Currency"), "Arial", 14, True, False, False, 3, vbBlack, False, 13, 165.5
  847.                    
  848.                     Else
  849.                    
  850.                         Say Format(Int((Rec16!atualizado + Redond(Rec16!multa) + Redond(Rec16!juros)) * 100) / 100, "Currency"), "Arial", 14, True, False, False, 3, vbBlack, False, 13, 165.5
  851.                    
  852.                     End If
  853.            
  854.               Else
  855.    
  856.                 'primeira parte
  857.                Justifica DadosEmpresa("instrucoes") & Rec16!mes_fatura, "Arial", 8, True, False, False, 1, vbBlack, 11, 113
  858.                
  859.                 Call Conectar_MYSQL
  860.                
  861.                 'mensagem IVR
  862.                Set Rec57 = New ADODB.Recordset
  863.                 Rec57.Open "SELECT * FROM mjconrec WHERE fatura = '" & Rec16!fatura & "' AND ivr = 1", ConMysql, adOpenStatic, adLockReadOnly
  864.                
  865.                 If Rec57.RecordCount > 0 Then
  866.                     Justifica DadosEmpresa("msgivr"), "Arial", 8, True, False, False, 1, vbBlack, 11, 126
  867.                     vIVR = True
  868.                   Else
  869.                     'If Rec56!IVR Then
  870.                        Justifica DadosEmpresa("msgivr"), "Arial", 8, True, False, False, 1, vbBlack, 11, 126
  871.                     'End If
  872.                End If
  873.                
  874.                
  875.                 'montar nosso numero com um numero a esquerda para completar a quantidade de digitos
  876.                vNossoNum = Rec16!fatura & "-" & NossoNumero(Rec16!fatura, Rec07!carteira)
  877.                
  878.                 'Say Rec16!descricao, "Arial", 8, True, False, False, 1, vbBlack, False, 10.5, 148
  879.                'Say "", "Arial", 8, True, False, False, 1, vbBlack,  True, 10.5, 0
  880.                Say "", "Arial", 8, True, False, False, 1, vbBlack, True, 10.5, 145
  881.                
  882.                 Call Conectar_MYSQL
  883.                
  884.                 'descrições de lançamentos
  885.                Set Rec57 = New ADODB.Recordset
  886.                 Rec57.Open "SELECT * FROM mjconrec WHERE fatura = '" & Rec16!fatura & "'", ConMysql, adOpenStatic, adLockReadOnly
  887.                
  888.                 If Rec57.RecordCount > 0 Then
  889.                     Say Rec16!descricao, "Arial", 8, True, False, False, 1, vbBlack, True, 10.5, 0
  890.                    
  891.                     Do While Not Rec57.EOF
  892.                         If Rec57!descricao = "Micros Adicionais na rede do cliente" Then
  893.                             vContMA = vContMA + 1
  894.                             vValMA = vValMA + Rec57!valor
  895.                         End If
  896.                         If Rec57!descricao = "Desconto" Then
  897.                             vContDesc = vContDesc + 1
  898.                             vValDesc = vValDesc + Rec57!valor
  899.                         End If
  900.                         If Rec57!descricao = "Ref. ao Valor do SCM" Then
  901.                             vContSCM = vContSCM + 1
  902.                             vValSCM = vValSCM + Rec57!valor
  903.                         End If
  904.                         If Rec57!descricao = "Ref. ao Suporte do Plano Corp." Then
  905.                             vContPC = vContPC + 1
  906.                             vValPC = vValPC + Rec57!valor
  907.                         End If
  908.                         If Rec57!descricao <> "Desconto" And Rec57!descricao <> "Micros Adicionais na rede do cliente" And Rec57!descricao <> "Ref. ao Valor do SCM" And Rec57!descricao <> "Ref. ao Suporte do Plano Corp." Then
  909.                             Say Rec57!descricao, "Arial", 8, True, False, False, 1, vbBlack, False, 13, 0
  910.                             Say Format(Rec57!valor, "Currency"), "Arial", 8, True, False, False, 3, vbBlack, True, 110, 0
  911.                         End If
  912.                         Rec57.MoveNext
  913.                     Loop
  914.                     If vContMA > 0 Then
  915.                         Say vContMA & " Micros Adicionais na rede do cliente", "Arial", 8, True, False, False, 1, vbBlack, False, 13, 0
  916.                         Say Format(vValMA, "Currency"), "Arial", 8, True, False, False, 3, vbBlack, True, 110, 0
  917.                     End If
  918.                     If vContDesc > 0 Then
  919.                         Say vContDesc & " Desconto(s)", "Arial", 8, True, False, False, 1, vbBlack, False, 13, 0
  920.                         Say Format(vValDesc, "Currency"), "Arial", 8, True, False, False, 3, vbBlack, True, 110, 0
  921.                     End If
  922.                     If vContSCM > 0 Then
  923.                         Say vContSCM & " Ref. ao Valor do SCM", "Arial", 8, True, False, False, 1, vbBlack, False, 13, 0
  924.                         Say Format(vValSCM, "Currency"), "Arial", 8, True, False, False, 3, vbBlack, True, 110, 0
  925.                     End If
  926.                     If vContPC > 0 Then
  927.                         Say vContPC & " Ref. ao Suporte do Plano Corp.", "Arial", 8, True, False, False, 1, vbBlack, False, 13, 0
  928.                         Say Format(vValPC, "Currency"), "Arial", 8, True, False, False, 3, vbBlack, True, 110, 0
  929.                     End If
  930.                    
  931.                   Else
  932.                         Say Rec16!descricao, "Arial", 8, True, False, False, 1, vbBlack, False, 10.5, 0
  933.                         Say Format(Rec16!valor, "Currency"), "Arial", 8, True, False, False, 3, vbBlack, True, 110, 0
  934.                 End If
  935.                        
  936.                 Say DadosEmpresa("razao"), "Arial", 8, True, False, False, 1, vbBlack, False, 105.5, 147
  937.                 Say vAgencia & "-" & vDigAgencia & " / " & vConta & "-" & vDigConta, "Arial", 8, True, False, False, 1, vbBlack, False, 171, 147
  938.                 Say Rec15!Codigo & "-" & Rec15!razao, "Arial", 8, True, False, False, 1, vbBlack, False, 105.5, 154
  939.                
  940.                 'verificando a data de emissao da nota fiscal
  941.                If Rec16!datanf <> Empty Or Not IsNull(Rec16!datanf) Then
  942.                     If Rec16!datanf > Rec16!emissao Then
  943.                         Say Format(Rec16!datanf, "dd/mm/yyyy"), "Arial", 8, True, False, False, 1, vbBlack, False, 105.5, 161
  944.                       Else
  945.                         Say Format(Rec16!emissao, "dd/mm/yyyy"), "Arial", 8, True, False, False, 1, vbBlack, False, 105.5, 161
  946.                     End If
  947.                   Else
  948.                     Say Format(Rec16!emissao, "dd/mm/yyyy"), "Arial", 8, True, False, False, 1, vbBlack, False, 105.5, 161
  949.                 End If
  950.                
  951.                 Say vNossoNum, "Arial", 8, True, False, False, 1, vbBlack, False, 124.5, 161
  952.                 Say Rec16!fatura, "Arial", 8, True, False, False, 1, vbBlack, False, 151.5, 161
  953. '                Say Format(Rec16!Data, "mm/yy"), "Arial", 8, True, False, False, 1, vbBlack, False, 180, 161
  954. '                Say Format(Rec16!Data, "dd/mm/yyyy"), "Arial", 14, True, False, False, 1, vbBlack, False, 122, 165.5
  955.                Say Format(vDataVenc, "mm/yy"), "Arial", 8, True, False, False, 1, vbBlack, False, 180, 161
  956.                 Say Format(vDataVenc, "dd/mm/yyyy"), "Arial", 14, True, False, False, 1, vbBlack, False, 122, 165.5
  957.                 If Rec16!pagamento = "P" Then
  958.                     Say Format(Int(Rec16!atualizado * 100) / 100, "Currency"), "Arial", 14, True, False, False, 3, vbBlack, False, 11, 165.5
  959.                   Else
  960.                     Say Format(Int((Rec16!atualizado + Redond(Rec16!multa) + Redond(Rec16!juros)) * 100) / 100, "Currency"), "Arial", 14, True, False, False, 3, vbBlack, False, 11, 165.5
  961.                 End If
  962.                
  963.             End If
  964.            
  965.             'segunda parte
  966.            
  967.             Say "Pagável Preferencialmente em qualquer Agência Bradesco", "Arial", 8, True, False, False, 1, vbBlack, False, 10.5, 198.14
  968. '            Say Format(Rec16!Data, "dd/mm/yyyy"), "Arial", 14, True, False, False, 3, vbBlack, False, 11, 195.7
  969.            Say Format(vDataVenc, "dd/mm/yyyy"), "Arial", 14, True, False, False, 3, vbBlack, False, 11, 195.7
  970.             Say DadosEmpresa("razao"), "Arial", 8, True, False, False, 1, vbBlack, False, 10.5, 206.14
  971.             Say vAgencia & "-" & vDigAgencia & " / " & vConta & "-" & vDigConta, "Arial", 8, True, False, False, 3, vbBlack, False, 11, 206.14
  972.            
  973.             'verificando a data de emissao da nota fiscal
  974.            If Rec16!datanf <> Empty Or Not IsNull(Rec16!datanf) Then
  975.                 If Rec16!datanf > Rec16!emissao Then
  976.                     Say Format(Rec16!datanf, "dd/mm/yyyy"), "Arial", 8, True, False, False, 1, vbBlack, False, 10.5, 213.14
  977.                   Else
  978.                     Say Format(Rec16!emissao, "dd/mm/yyyy"), "Arial", 8, True, False, False, 1, vbBlack, False, 10.5, 213.14
  979.                 End If
  980.               Else
  981.                 Say Format(Rec16!emissao, "dd/mm/yyyy"), "Arial", 8, True, False, False, 1, vbBlack, False, 10.5, 213.14
  982.             End If
  983.            
  984.             Say Rec16!fatura, "Arial", 8, True, False, False, 1, vbBlack, False, 37, 213.14
  985.             Say "N", "Arial", 8, True, False, False, 1, vbBlack, False, 87.3, 213.14
  986.            
  987.             'verificando a data de emissao da nota fiscal
  988.            If Rec16!datanf <> Empty Or Not IsNull(Rec16!datanf) Then
  989.                 If Rec16!datanf > Rec16!emissao Then
  990.                     Say Format(Rec16!datanf, "dd/mm/yyyy"), "Arial", 8, True, False, False, 1, vbBlack, False, 94, 213.14
  991.                   Else
  992.                     Say Format(Rec16!emissao, "dd/mm/yyyy"), "Arial", 8, True, False, False, 1, vbBlack, False, 94, 213.14
  993.                 End If
  994.               Else
  995.                 Say Format(Rec16!emissao, "dd/mm/yyyy"), "Arial", 8, True, False, False, 1, vbBlack, False, 94, 213.14
  996.             End If
  997.            
  998.             Say vCarteira & " / " & vNossoNum, "Arial", 8, True, False, False, 3, vbBlack, False, 10, 213.14
  999.             Say vCarteira, "Arial", 8, True, False, False, 1, vbBlack, False, 37.5, 220.34
  1000.             Say "", "Arial", 8, True, False, False, 1, vbBlack, False, 30.5, 220.34
  1001.             Say "R$", "Arial", 8, True, False, False, 1, vbBlack, False, 56.5, 220.34
  1002.            
  1003.            
  1004.             '<================================================== VALOR ( PARTE INFERIOR DO BOLETO ) ==============================================>
  1005.            If Rec16!pagamento = "P" Then
  1006.                 Say Format(Int(Rec16!atualizado * 100) / 100, "Currency"), "Arial", 14, True, False, False, 3, vbBlack, False, 11, 217.84
  1007.               Else
  1008.                 Say Format(Int((Rec16!atualizado + Redond(Rec16!multa) + Redond(Rec16!juros)) * 100) / 100, "Currency"), "Arial", 14, True, False, False, 3, vbBlack, False, 13, 217.84
  1009.             End If
  1010.             Justifica DadosEmpresa("instrucoes") & Rec16!mes_fatura, "Arial", 8, True, False, False, 1, vbBlack, 13, 230
  1011.             'mensagem IVR
  1012.            If vIVR Then
  1013.                 Justifica DadosEmpresa("msgivr"), "Arial", 8, True, False, False, 1, vbBlack, 13, 248
  1014.             Else
  1015.                 'If Rec56!IVR Then
  1016.                    If Rec16!NumNota = Empty Then Justifica DadosEmpresa("msgivr"), "Arial", 8, True, False, False, 1, vbBlack, 11, 126
  1017.                 'End If
  1018.            End If
  1019.            
  1020.             '<=========================================== VALOR COBRADO =========================================>
  1021.            
  1022.             If Rec16!pagamento = "P" Then
  1023.                 Say Format(Int(Rec16!valorpagto * 100) / 100, "Currency"), "Arial", 14, True, False, False, 3, vbBlack, False, 11, 251.14
  1024.               Else
  1025.                 Say "", "Arial", 14, True, False, False, 3, vbBlack, False, 11, 251.14
  1026.             End If
  1027.            
  1028.            
  1029.             'Verifica se é preciso imprimir nota fiscal para o cliente
  1030.            If Rec16!NumNota <> Empty Then
  1031.            
  1032.                 Say Rec15!Codigo & "-" & Rec15!razao, "Arial", 8, True, False, False, 1, vbBlack, False, 22, 256.64
  1033.                
  1034.               Else
  1035.              
  1036.                 Say Rec15!Codigo & "-" & Rec15!razao, "Arial", 8, True, False, False, 1, vbBlack, False, 22, 256.64
  1037.                 If Len(Rec15!cgc) = 11 Then
  1038.                     Say Format(Rec15!cgc, "000 000 000-00"), "Arial", 8, True, False, False, 3, vbBlack, False, 11, 256.64
  1039.                   Else
  1040.                     Say Format(Rec15!cgc, "000 000 000/0000-00"), "Arial", 8, True, False, False, 3, vbBlack, False, 11, 256.64
  1041.                 End If
  1042.                 Say Rec15!ie, "Arial", 8, True, False, False, 3, vbBlack, False, 11, 260
  1043.                 Say Rec15!endereco & " - " & Rec15!bairro, "Arial", 8, True, False, False, 1, vbBlack, False, 22, 259.64
  1044.                 Say Rec15!ciddescr & " - " & Rec15!estado, "Arial", 8, True, False, False, 1, vbBlack, False, 22, 262.64
  1045.                
  1046.             End If
  1047.                    
  1048.            
  1049.             'campo livre
  1050.            vCampoLivre = vAgencia
  1051.             vCampoLivre = vCampoLivre & vCarteira
  1052.             vCampoLivre = vCampoLivre & Rec16!fatura
  1053.             vCampoLivre = vCampoLivre & Format(vConta, "0000000")
  1054.             vCampoLivre = vCampoLivre & "0"
  1055.    
  1056.            
  1057.             'linha digitavel
  1058.            
  1059.            
  1060.             'fator de vencimento
  1061. '            fVencimento = Rec16!Data - CDate("07/10/1997")
  1062.            fVencimento = vDataVenc - CDate("07/10/1997")
  1063.            
  1064.             If fVencimento > 9999 Or fVencimento < 1000 Then
  1065.                 MsgBox "Data Inválida ! ", vbCritical, App.ProductName
  1066.                 Unload Me
  1067.                 Exit Function
  1068.             End If
  1069.            
  1070.            
  1071.             'codigo do banco
  1072.            If IsNull(vBanco) Then
  1073.                 vLinhaD1 = Mid(DadosEmpresa("banco"), 2, 3)
  1074.               Else
  1075.                 vLinhaD1 = Mid(vBanco, 2, 3)
  1076.             End If
  1077.             'Moeda
  1078.            vLinhaD1 = vLinhaD1 & "9"
  1079.             '5 Primeiras Posições do Campo Livre
  1080.            vLinhaD1 = vLinhaD1 & Mid(vCampoLivre, 1, 5)
  1081.             'calcula o digito do primeiro campo
  1082.            vLinhaD1 = vLinhaD1 & Trim(Calculo_DV10(vLinhaD1))
  1083.            
  1084.             'colocando primeiro campo na linha digitavel
  1085.            vLinhaD = Mid(vLinhaD1, 1, 5) & "." & Mid(vLinhaD1, 6, 5)
  1086.            
  1087.            
  1088.             'da 6ª até a 15ª Posição do Campo Livre
  1089.            vLinhaD2 = Mid(vCampoLivre, 6, 10)
  1090.             'calcula o digito do segundo campo
  1091.            vLinhaD2 = vLinhaD2 & Calculo_DV10(vLinhaD2)
  1092.            
  1093.             'colocando segundo campo na linha digitavel
  1094.            vLinhaD = vLinhaD & "  " & Mid(vLinhaD2, 1, 5) & "." & Mid(vLinhaD2, 6, 6)
  1095.            
  1096.             'da 16ª até a 25ª Posição do Campo Livre
  1097.            vLinhaD3 = Mid(vCampoLivre, 16, 10)
  1098.             'calcula o digito do terceiro campo
  1099.            vLinhaD3 = vLinhaD3 & Calculo_DV10(vLinhaD3)
  1100.            
  1101.             'colocando terceiro campo na linha digitavel
  1102.            vLinhaD = vLinhaD & "  " & Mid(vLinhaD3, 1, 5) & "." & Mid(vLinhaD3, 6, 6)
  1103.            
  1104.            
  1105.             'quarto campo ( digito do codigo de barras )
  1106.            
  1107.             'montando digitos do codigo de barras
  1108.            If IsNull(vBanco) Then
  1109.                 vCodBar = Mid(DadosEmpresa("banco"), 2, 3)
  1110.               Else
  1111.                 vCodBar = Mid(vBanco, 2, 3)
  1112.             End If
  1113.             vCodBar = vCodBar & "9"
  1114.             vCodBar = vCodBar & Trim(str(fVencimento))
  1115.             vCodBar = vCodBar & Format(Int(vValorBoleto * 100), "0000000000")
  1116.             vCodBar = vCodBar & vCampoLivre
  1117.                    
  1118.             vLinhaD4 = calcula_DV_CodBarras(vCodBar)
  1119.            
  1120.            
  1121.             'colocando quarto campo na linha digitavel
  1122.            vLinhaD = vLinhaD & "  " & vLinhaD4
  1123.            
  1124.            
  1125.             'quinto campo
  1126.            
  1127.             vLinhaD5 = Trim(str(fVencimento))
  1128.             'formatando valor
  1129.            vLinhaD5 = vLinhaD5 & Format(Int(vValorBoleto * 100), "0000000000")
  1130.                    
  1131.             'colocando quinto campo na linha digitavel
  1132.            vLinhaD = vLinhaD & "  " & vLinhaD5
  1133.            
  1134.             If Rec16!pagamento = "P" Then
  1135.            
  1136.                 Say "FATURA PAGA.", "Arial", 10, True, False, False, 3, vbBlack, False, 12, 190
  1137.             Else
  1138.            
  1139.                 Say vLinhaD, "Arial", 10, True, False, False, 3, vbBlack, False, 12, 190
  1140.            
  1141.             End If
  1142.            
  1143.            
  1144.             'barra Mid(vLinhaD1, 1, 5), Mid(vLinhaD1, 6, 5), Mid(vLinhaD2, 1, 5), Mid(vLinhaD2, 6, 6), Mid(vLinhaD3, 1, 5), Mid(vLinhaD3, 6, 6), vLinhaD4, vLinhaD5, 270, 10
  1145.            
  1146.             'montando o codigo de barras
  1147.            If IsNull(vBanco) Then
  1148.                 vCodBar = Mid(DadosEmpresa("banco"), 2, 3)
  1149.             Else
  1150.                 vCodBar = Mid(vBanco, 2, 3)
  1151.             End If
  1152.             vCodBar = vCodBar & "9"
  1153.             vCodBar = vCodBar & Trim(vLinhaD4) 'digito verificador do codigo de barras
  1154.            vCodBar = vCodBar & Trim(str(fVencimento))
  1155.             vCodBar = vCodBar & Format(Int(vValorBoleto * 100), "0000000000")
  1156.             vCodBar = vCodBar & vCampoLivre
  1157.            
  1158.            
  1159.            
  1160.             If Rec16!pagamento = "P" Then
  1161.            
  1162.                 Say "FATURA PAGA.", "Arial", 14, True, False, False, 3, vbBlack, False, 162, 270
  1163.            
  1164.             Else
  1165.      
  1166.                 Barra vCodBar, 270, 10
  1167.            
  1168.             End If
  1169.  
  1170.  
  1171.         End If
  1172.        
  1173.         End With
  1174.        
  1175.         If vVersoContas Then
  1176.             ImprimirVerso
  1177.         End If
  1178.        
  1179.     Next
  1180.     'Loop
  1181.  
  1182. Exit Function
  1183.  
  1184. erro:
  1185.  
  1186. MsgBox "Erro gerando boleto !" & vbNewLine & "Por favor entre em contato com o suporte informando o codigo abaixo:" & vbNewLine & err.Description, vbCritical, App.ProductName
  1187.  
  1188. GravaErro err.Description, "impres. boletos"
  1189.  
  1190. Resume Next 'retirar
  1191.  
  1192. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!