Codigo de Barra e Linha Digitavel

[Alex Lugon]

Boa Noite pessoal, gostaria de saber se algum tem alguma função que gere os numeros para o Codigo de Barra e os Numeros da Linha digitavel do Banco Caixa Economica Federal?

Ou se alguém tem algum explo de como poço fazer isso...

Muito obrigado.

[Alex Lugon]

:D Ola pessoal com um pouquinho daqui e um pouqunho dali eu consegui fazer e segue abaixo o codigo.

Option Explicit

Dim DV11 As Integer

Public Function MontarBarra(CodAgencia As String, CodCedente As String, NossoNumero As String, ValorTotal, DataVencimento As Date)

Dim CodBarra As String

Dim DataBase As Date

Dim CampoLivre As String

Dim DataFator As Integer

CodAgencia = Format(CodAgencia, "0000")

CodCedente = Format(CodCedente, "000000")

NossoNumero = Format(NossoNumero, "990000000000000000")

'FORMATA O VALOR

ValorTotal = Replace(ValorTotal, ",", "")

ValorTotal = Replace(ValorTotal, ".", "")

ValorTotal = Format(ValorTotal, "0000000000")

'Calcula a data e transforma

DataBase = CDate("7/10/1997")

DataFator = DateDiff("d", DataBase, Format(DataVencimento, "dd/mm/yyyy"))

CampoLivre = "1" & CodCedente & NossoNumero

CodBarra = "104" & "9" & DataFator & ValorTotal & CampoLivre

DV11 = Calculo_DV11(CodBarra)

CodBarra = "104" & "9" & DV11 & DataFator & ValorTotal & CampoLivre

MontarBarra = CodBarra

End Function

Public Function MontarLinhaDigitavel(CodigoBarra As String)

Dim seq1 As String

Dim DV10 As String

Dim Campo1 As String

Dim Campo2 As String

Dim Campo3 As String

'MONTA PRIMEIRO CAMPO DA LINHA DIGITAVEL

seq1 = "104" & "9" & Mid(CodigoBarra, 20, 5)

DV10 = Calculo_DV10(seq1)

Campo1 = Mid(seq1, 1, 5) & "." & Mid(seq1, 6, 5) & Trim(DV10)

'MONTA SEGUNDO CAMPO DA LINHA DIGITAVEL

seq1 = Mid(CodigoBarra, 25, 10)

DV10 = Calculo_DV10(seq1)

Campo2 = Mid(seq1, 1, 5) & "." & Mid(seq1, 6, 5) & Trim(DV10)

'MONTA TERCEIRO CAMPO DA LINHA DIGITAVEL

seq1 = Mid(CodigoBarra, 35, 10)

DV10 = Calculo_DV10(seq1)

Campo3 = Mid(seq1, 1, 5) & "." & Mid(seq1, 6, 5) & Trim(DV10)

MontarLinhaDigitavel = Campo1 & " " & Campo2 & " " & Campo3 & " " & DV11 & " " & Mid(CodigoBarra, 6, 14)

End Function

Function Calculo_DV10(strNumero As String) As String

'declara As variáveis

Dim intContador As Integer

Dim intNumero As Integer

Dim intTotalNumero As Integer

Dim intMultiplicador As Integer

Dim intResto As Integer

' se não for um valor numerico sai da função

If Not IsNumeric(strNumero) Then

Calculo_DV10 = ""

Exit Function

End If

'inicia o multiplicador

intMultiplicador = 2

'pega cada caracter do numero a partir da direita

For intContador = Len(strNumero) To 1 Step -1

'extrai o caracter e multiplica pelo multiplicador

intNumero = Val(Mid(strNumero, intContador, 1)) * intMultiplicador

' se o resultado for maior que nove soma os algarismos do resultado

If intNumero > 9 Then

intNumero = Val(Left(intNumero, 1)) + Val(Right(intNumero, 1))

End If

'soma o resultado para totalização

intTotalNumero = intTotalNumero + intNumero

'se o multiplicador for igual a 2 atribuir valor 1 se for 1 atribui 2

intMultiplicador = IIf(intMultiplicador = 2, 1, 2)

Next

Dim DezenaSuperior As Integer

If intTotalNumero < 10 Then

DezenaSuperior = 10

Else

DezenaSuperior = 10 * (Val(Left(CStr(intTotalNumero), 1)) + 1)

End If

intResto = DezenaSuperior - intTotalNumero

'verifica as exceções ( 0 -> DV=0 )

Select Case intResto

Case 0

Calculo_DV10 = "0"

Case Else

Calculo_DV10 = Str(intResto)

End Select

End Function

Function Calculo_DV11(strNumero As String) As String

'declara as variáveis

Dim intContador As Integer

Dim intNumero As Integer

Dim intTotalNumero As Integer

Dim intMultiplicador As Integer

Dim intResto As Integer

' se não for um valor numerico sai da função

If Not IsNumeric(strNumero) Then

Calculo_DV11 = ""

Exit Function

End If

'inicia o multiplicador

intMultiplicador = 9

'pega cada caracter do numero a partir da direita

For intContador = Len(strNumero) To 1 Step -1

'extrai o caracter e multiplica prlo multiplicador

intNumero = Val(Mid(strNumero, intContador, 1)) * intMultiplicador

'soma o resultado para totalização

intTotalNumero = intTotalNumero + intNumero

'se o multiplicador for maior que 2 decrementa-o caso contrario atribuir valor padrão original

intMultiplicador = IIf(intMultiplicador > 2, intMultiplicador - 1, 9)

Next

'calcula o resto da divisao do total por 11

intResto = intTotalNumero Mod 11

'verifica as exceções ( 0 -> DV=0 10 -> DV=X (para o BB) e retorna o DV

Select Case intResto

Case 0

Calculo_DV11 = "0"

Case 10

Calculo_DV11 = "X"

Case Else

Calculo_DV11 = Str(intResto)

End Select

End Function