Caros amigos, tenho codigo de barras, so q o calculo q gera o digito verificador nao esta gerando corretamente, o digito ta ficando errado no calculo do modulo 10 e 11, veja o codigo q uso:
===============================================================
MODULO
'VARIÁVEIS PARA O CÓDIGO DE BARRAS
Public GRCODBAR As String '44 P. CODIGO DA BARRA
Public GRCBOXES As String '48 P. CODIGO / LINHA DIGITAVEL
Public GRVVALOR As Currency '11 DIGITOS 'VALOR TOTAL DO CODIGO
'Valor: 55,00
Public GRIDENTI As String '4 DIGITOS 'CONVENIO
'0000
Public GRCODCON As String '13 DIGITOS 'CODIGO DO CONTRIBUINTE
'Contribuinte: 100.002.0003.004
Public GRCODPAR As String '2 DIGITOS 'CODIGO DA PARCELA
'Parcela: 01
Public GRDATAVE As String '8 DIGITOS 'DATA DE VENCIMENTO
Public GA As String
Public GB As String
Public GC As String
'DataVencimento: 03/04/2004
'Public GRCBANCO As String '3 DIGITOS 'BANCO
'Banco: 031
'Public GRAGENCI As String '4 DIGITOS 'AGENCIA
'Agencia: 114
'-------------------------CODIGO PRONTO---------------------------
'OBRIGATORIO VALOR CONVENIO SEUS DADOS
'8165 00000009211 0173 8772200303310110780867000
'18 + O DIGITO GERAL
'ANTES DE FICAR PRONTO ELE FICA ASSIM-----------------------------
'816000000092110173 8772200303310110780867000
'VC TEM 25 DIGITOS PARA SEU USO. POR ISSO O BANCO A AGENCIA NAO PODERA IR JUNTO
'VOU ACRESCENTAR 2 ZEROS A ESQUERDA DO CONTRIBUINTE - LEMBRE-SE DISSO NA HORA DE BAIXAR
'OBS.: TODOS OS DADOS ACIMA DEVERAO SER TRATADOS, OU SEJA ELES SO VEM PARA
' AS VARIAVEIS COM O SEU VALOR FINAL - SOMENTE NUMEROS
'CODIGO BARRAS..............................................................................
Public Function CODBAR()
'GRIDENTI = "0137" 'CÓDIGO DO CONVENIO - DEIXE AQUI O NUMERO DO CONVENIO
Dim GD As String
Dim GE As String
Dim GF As String
Dim GG As String
Dim GCOD As String
Dim goma As Double
Dim g1 As Double
Dim g2 As Double
Dim gdig As Double
Dim pos As Double
Dim GRVIGGGG As Double
Dim box1, box2, box3, box4 As String
Dim XDG, XD1, XD2, XD3, XD4 As String
GA = "8" 'MUDE AQUI PARA O PADRAO QUE A FEBRABAN TE PASSOU
GB = "1" 'CADA UM DESSES NUMEROS TEM UM SIGNIFICADO
GC = "6" 'ESSES TAMBEM SAO FIXOS
GCENTS = GRVVALOR - Int(GRVVALOR)
If Len(GCENTS) = 1 Then GCENTS = "00"
If Len(GCENTS) = 3 Then GCENTS = Right(GCENTS, 1) & "0"
If Len(GCENTS) = 4 Then GCENTS = Right(GCENTS, 2)
GE = "00" & GCENTS & Int(GRVVALOR)
GE = "00" & Right(1000000000 + Int(GE), 9)
GF = GRIDENTI
GRDATAVE = "" & GRDATAVE 'se for pra cavalcante abilita este
'GRDATAVE = "00" & GRDATAVE 'se for pra alto paraiso abilita esse
GG = GRDATAVE & GRCODPAR & GRCODCON
GCOD = GA & GB & GC & GE & GF & GG
TEXTOSIM = GCOD
XDG = Left(TEXTOSIM, 4): XDG = Right(XDG, 1) 'digito geral
TEXTOSIM = Left(TEXTOSIM, 3) & Right(TEXTOSIM, 40) 'sem o digito geral
box1 = Left(GCOD, 10)
box2 = Left(GCOD, 21): box2 = Right(box2, 11)
box3 = Left(GCOD, 32): box3 = Right(box3, 11)
box4 = Right(GCOD, 11)
'VERIFICAMDO O DIGITO GERAL
Dim posi, soma, mulp As Double 'posicao do digito
Dim Cont As String
Dim somg As Double
Dim ACAO, condicao As Double
posi = 0 'posicao do texto
soma = 0 'soma o conteudo da posicao e multiplica pelo multi
somg = 0 'soma geral
mulp = 2 'multiplicador 2ou1
ACAO = 0: condicao = 0
Do While ACAO < 5
ACAO = ACAO + 1
condicao = 11
If ACAO = 1 Then condicao = 43 'VERIFICA O DIGITO GERAL
If ACAO = 2 Then TEXTOSIM = Left(box1, 3) & XDG & Right(box1, 7) ' MsgBox Len(TEXTOSIM) 'VERIFICA O DIGITO 1 BOX
If ACAO = 3 Then TEXTOSIM = box2 ' MsgBox TEXTOSIM 'VERIFICA O DIGITO 2 BOX
If ACAO = 4 Then TEXTOSIM = box3 ' MsgBox TEXTOSIM 'VERIFICA O DIGITO 3 BOX
If ACAO = 5 Then TEXTOSIM = box4 ' MsgBox TEXTOSIM 'VERIFICA O DIGITO 4 BOX
posi = 0 'posicao do texto
soma = 0 'soma o conteudo da posicao e multiplica pelo multi
somg = 0 'soma geral
mulp = 2 'multiplicador 2ou1
Do While posi < condicao
posi = posi + 1
Cont = Left(TEXTOSIM, posi): Cont = Right(Cont, 1)
soma = Val(Cont) * mulp
If soma >= 10 Then
xsom = soma
somg = somg + Val(Left(xsom, 1)) + Val(Right(xsom, 1))
soma = Val(Left(xsom, 1)) + Val(Right(xsom, 1))
Else
somg = somg + soma
End If
If mulp = 2 Then
mulp = 1
Else
mulp = 2
End If
Loop
If somg > 10 Then
a = somg / 10 ' divisao
b = Int(a) * 10 ' multiplicando para chegar ao resultado
c = somg - b ' achando o resto
If c > 0 Then
somg = 10 - c
Else
somg = 0
End If
Else
somg = 10 - somg
End If
If ACAO = 1 Then 'ACAO -ACHANDO O DIGITO GERAL
XDG = somg
GRCODBAR = Left(box1, 3) & XDG & Right(box1, 7) & box2 & box3 & box4
End If
If ACAO = 2 Then 'ACAO -ACHANDO O DIGITO 1 BOX
box1 = Left(GCOD, 10)
box1 = Left(box1, 3) & XDG & Right(box1, 7) & " " & somg
End If
If ACAO = 3 Then 'ACAO -ACHANDO O DIGITO 2 BOX
box2 = box2 & " " & somg
End If
If ACAO = 4 Then 'ACAO -ACHANDO O DIGITO 3 BOX
box3 = box3 & " " & somg
End If
If ACAO = 5 Then 'ACAO -ACHANDO O DIGITO 4 BOX
box4 = box4 & " " & somg
End If
DoEvents
Loop
GRCBOXES = box1 & " " & box2 & " " & box3 & " " & box4
End Function
============================================================
alguem poderia me ajudar a corrigir isso, com base no layout 4 da frebraban, esse codigo é gerado pra fins d recolhimento d impostos (IPTU)... e to precisando disso urgente...
