Mensaje enviado por "Marcelo R. Muzzio" <m.muzzio@assistsa.com>

SI:

Te mando la función... espero solucione tu problema...

Marcelo R. Muzzio
ASSIST Servicios en Sistemas de Información S.A.
m.muzzio@assistsa.com m.muzzio@assistsa.com>

////////////////////////////////////////////////////////////////////////////
///////

Public Enum CodBarrasDigVerificNorma
  CodBarrasDigVerificNorma_EAN_13 = 1
  CodBarrasDigVerificNorma_EAN_8 = 2
  CodBarrasDigVerificNorma_UPC_E = 3
  CodBarrasDigVerificNorma_DUN_14 = 4
End Enum

Public Function CodBarrasDigVerific(ByVal asCodigo As String, ByVal aiNorma
As CodBarrasDigVerificNorma) As String

  'Calcula el dígito verificador de un código de barras (asCodigo) según
  'la norma aiNorma ( 1-EAN 13, 2-EAN 8, 3-UPC E, 4-DUN 14) y retorna un
  'string con el dígito o un error

  Dim ls_ret As String
  Dim Total, xExpandido, Paso1, Paso2, Paso3, Paso4, Paso4a, Paso5, Paso6

  asCodigo = Trim(asCodigo)

  Select Case aiNorma
    Case CodBarrasDigVerificNorma_EAN_13
'-------------------------------------------------------------
      If Len(asCodigo) <> 12 Then
        ls_ret = "Longuitud no valida"
      Else
        Paso1 = ((Mid(asCodigo, 11, 1) * 1) + (Mid(asCodigo, 9, 1) * 1) + _
                (Mid(asCodigo, 7, 1) * 1) + (Mid(asCodigo, 5, 1) * 1) + _
                (Mid(asCodigo, 3, 1) * 1) + (Mid(asCodigo, 1, 1) * 1))
        Paso2 = ((Mid(asCodigo, 12, 1) * 3) + (Mid(asCodigo, 10, 1) * 3) + _
                (Mid(asCodigo, 8, 1) * 3) + (Mid(asCodigo, 6, 1) * 3) + _
                (Mid(asCodigo, 4, 1) * 3) + (Mid(asCodigo, 2, 1) * 3))
        Paso3 = Paso1 + Paso2
        Paso4 = Int(Paso3 / 10)
        Paso5 = Int(((Paso3 / 10) - Paso4) * 10)
        Paso6 = 10 - Paso5
        ls_ret = Right(Paso6, 1)
      End If

    Case CodBarrasDigVerificNorma_EAN_8
'-----------------------------------------------------------
      If Len(asCodigo) <> 7 Then
        ls_ret = "Longuitud no valida"
      Else
        Paso1 = ((Mid(asCodigo, 6, 1) * 1) + (Mid(asCodigo, 4, 1) * 1) +
(Mid(asCodigo, 2, 1) * 1))
        Paso2 = ((Mid(asCodigo, 7, 1) * 3) + (Mid(asCodigo, 5, 1) * 3) +
(Mid(asCodigo, 3, 1) * 3) + _
                (Mid(asCodigo, 1, 1) * 3))
        Paso3 = Paso1 + Paso2
        Paso4 = Int(Paso3 / 10)
        Paso5 = Int(((Paso3 / 10) - Paso4) * 10)
        Paso6 = 10 - Paso5
        ls_ret = Right(Paso6, 1)
      End If

    Case CodBarrasDigVerificNorma_UPC_E 'UPC
E -------------------------------------------------------------
      If Len(asCodigo) <> 6 Then
        ls_ret = "Longuitud no valida"
      Else
        Select Case Mid(asCodigo, 6, 1)
          Case 0, 1, 2
            xExpandido = Mid(asCodigo, 1, 1) & Mid(asCodigo, 2, 1) &
Mid(asCodigo, 6, 1) & _
                         "0000" & Mid(asCodigo, 3, 1) & Mid(asCodigo, 4, 1)
& Mid(asCodigo, 5, 1)
          Case 3
            xExpandido = Mid(asCodigo, 1, 1) & Mid(asCodigo, 2, 1) &
Mid(asCodigo, 3, 1) & _
                         "00000" & Mid(asCodigo, 4, 1) & Mid(asCodigo, 5, 1)
          Case 4
            xExpandido = Mid(asCodigo, 1, 1) & Mid(asCodigo, 2, 1) &
Mid(asCodigo, 3, 1) & _
                         Mid(asCodigo, 4, 1) & "00000" & Mid(asCodigo, 5, 1)
          Case Else
            xExpandido = Mid(asCodigo, 1, 1) & Mid(asCodigo, 2, 1) &
Mid(asCodigo, 3, 1) & _
                         Mid(asCodigo, 4, 1) & Mid(asCodigo, 5, 1) & "0000"
& Mid(asCodigo, 6, 1)
        End Select
        Total = ((Mid(xExpandido, 1, 1) * 1) + (Mid(xExpandido, 2, 1) * 3) +
_
               (Mid(xExpandido, 3, 1) * 1) + (Mid(xExpandido, 4, 1) * 3) + _
               (Mid(xExpandido, 5, 1) * 1) + (Mid(xExpandido, 6, 1) * 3) + _
               (Mid(xExpandido, 7, 1) * 1) + (Mid(xExpandido, 8, 1) * 3) + _
               (Mid(xExpandido, 9, 1) * 1) + (Mid(xExpandido, 10, 1) * 3))
Mod 10
        If Total = 0 Then
          Total = 10
        End If
        ls_ret = 10 - Total
      End If

    Case CodBarrasDigVerificNorma_DUN_14 'DUN
14 ------------------------------------------------------------
      If Len(asCodigo) <> 13 Then
        ls_ret = "Longuitud no valida"
      Else
        Paso1 = ((Mid(asCodigo, 13, 1) * 1) + (Mid(asCodigo, 11, 1) * 1) + _
                (Mid(asCodigo, 9, 1) * 1) + (Mid(asCodigo, 7, 1) * 1) + _
                (Mid(asCodigo, 5, 1) * 1) + (Mid(asCodigo, 3, 1) * 1) +
(Mid(asCodigo, 1, 1) * 1))
        Paso2 = Paso1 * 3
        Paso3 = ((Mid(asCodigo, 12, 1) * 1) + (Mid(asCodigo, 10, 1) * 1) + _
                (Mid(asCodigo, 8, 1) * 1) + (Mid(asCodigo, 6, 1) * 1) + _
                (Mid(asCodigo, 4, 1) * 1) + (Mid(asCodigo, 2, 1) * 1))
        Paso4 = Paso2 + Paso3
        Paso4a = (Int(Paso4 / 10) + 1) * 10
        ls_ret = Right(Paso4a - Paso4, 1)
      End If

    Case Else
        ls_ret = "Norma Desconocida"
  End Select

  CodBarrasDigVerific = ls_ret
End Function

Mensaje enviado por Luisa Romeu <luisa@oficentral.caracol.cma.net>

Alberto:

Ve a ver si esta te sirve la hice yo pero me camina perfectamente:

Function DigChequeo(ByVal NCodigo As String) As String

    ' Mascara => 1 3 1 3 1 3 1 3 1 3 1 3
    ' NCodigo => 0 0 1 3 9 2 5 0 0 0 0 4
    ' ------------------------
    ' 0 0 1 9 9 6 5 0 0 0 0 12
    '
    ' NT => 0+0+1+9+9+6+5+0+0+0+0+ 2 = 32
    ' Si ParteDererecha(NT) = 0
    ' DigChequeo = 0
    ' SiNo
    ' DigChequeo = 10 - ParteDererecha(NT) => 10 - 2 = 8
    ' FinSi
    '
    Dim N1, N2, N3, N4, N5, N6, N7, N8, N9, N10, N11, N12, NT As Integer

     N1 = Left(NCodigo, 1) * 1
     N2 = Mid(NCodigo, 2, 1) * 3
     N3 = Mid(NCodigo, 3, 1) * 1
     N4 = Mid(NCodigo, 4, 1) * 3
     N5 = Mid(NCodigo, 5, 1) * 1
     N6 = Mid(NCodigo, 6, 1) * 3
     N7 = Mid(NCodigo, 7, 1) * 1
     N8 = Mid(NCodigo, 8, 1) * 3
     N9 = Mid(NCodigo, 9, 1) * 1
    N10 = Mid(NCodigo, 10, 1) * 3
    N11 = Mid(NCodigo, 11, 1) * 1
    N12 = Right(NCodigo, 1) * 3

    NT = CInt(Right(N1, 1)) + CInt(Right(N2, 1)) + CInt(Right(N3, 1)) +
CInt(Right(N4, 1)) + CInt(Right(N5, 1)) + CInt(Right(N6, 1)) +
CInt(Right(N7, 1)) + CInt(Right(N8, 1)) + CInt(Right(N9, 1)) +
CInt(Right(N10, 1)) + CInt(Right(N11, 1)) + CInt(Right(N12, 1))
    If Right(NT, 1) = "0" Then
       DigChequeo = 0
    Else
       DigChequeo = 10 - CInt(Right(NT, 1))
    End If
End Function


Suerte

            Luisa

Mensaje enviado por "Francisco" <starback@infonegocio.com> el 8/03/2002

Hola Fernando,

Aquí tienes una función para calcular el dígito de control de un EAN13:

Un Saludo.
Francisco.

Function CalcularDigitoControl(Origen As Double) as double

Dim WNúmero As Double
Dim Valor As Double
Dim LongitudTotal As Double
Dim LongitudTotal2 As Double
Dim Posición As Double
Dim PosiciónTotal As Double
Dim PosiciónRelativa As Double
Dim Parcial As Double
Dim TotalParciales As Double
Dim DígitoControl As Double
Dim DS As Double

TotalParciales = 0
WNúmero = Origen
Posición = 12
PosiciónRelativa = 1

Do Until Posición = 0
    Valor = CDbl(Mid(WNúmero, Posición, 1))
    Parcial = 0

    If PosiciónRelativa = 0 Or PosiciónRelativa = 2 Or PosiciónRelativa = 4 Or PosiciónRelativa = 6 Or PosiciónRelativa = 8 Or PosiciónRelativa = 10 Or PosiciónRelativa = 12 Then
    'PAR
        Parcial = (Valor * 1)
    End If

    If PosiciónRelativa = 1 Or PosiciónRelativa = 3 Or PosiciónRelativa = 5 Or PosiciónRelativa = 7 Or PosiciónRelativa = 9 Or PosiciónRelativa = 11 Then
    'INPAR
        Parcial = (Valor * 3)
    End If

    TotalParciales = TotalParciales + Parcial
    Posición = Posición - 1
    PosiciónRelativa = PosiciónRelativa + 1
Loop

LongitudTotal2 = Len("" & TotalParciales & "")

If CDbl(Mid(TotalParciales, LongitudTotal2, 1)) = 0 Then
    DígitoControl = 0
Else
    DS = TotalParciales

    Do Until CDbl(Mid(DS, LongitudTotal2, 1)) = 0
    DS = DS + 1
    Loop

    DígitoControl = DS - TotalParciales
End If

CalcularDigitoControl = WNúmero & DígitoControl

End Function