Check digit uitschakelen in een code?

[Hendrik2016]

Hallo handige mensen.
Graag wil ik een probleem voorleggen omdat ik van VBA geen kaas gegeten heb.
Deze code wil ik gebruiken om een barcode in mijn Excel bestand.

Het volgende.
Bijgevoegd de code van ConnectCodefree.
Deze genereert automatisch een " check digit code ".
Helaas kan ik dat niet gebruiken in verband met onleesbaarheid van de scanner.
Bijvoorbeeld 01477060 word 01477060P

Wil iemand me helpen deze verwijzing uit bijgevoegde code te halen?


Met vriendelijke groet en bij voorbaat mijn dank.

Hendrik.

'======================================================================================================
'Code39
'======================================================================================================
   
Public Function Encode_Code39(ByVal data As String, Optional ByVal chk As Integer = 1) As String

      
    Dim Result As String
    Dim cd As String
    Dim filtereddata As String
            
    filtereddata = filterInput_Code39(data)
    filteredlength = Len(filtereddata)

    If chk = 1 Then
    
        If filteredlength > 254 Then
        
            filtereddata = Left$(filtereddata, 254)
            
        End If
        cd = generateCheckDigit_Code39(filtereddata)
    
    Else
    
        If filteredlength > 255 Then
            
            filtereddata = Left$(filtereddata, 255)
            
        End If
    
    End If

    Result = "*" + filtereddata + cd + "*"
    Encode_Code39 = Result

End Function

Public Function getCode39Value(ByVal inputchar As Integer) As Integer

    Dim CODE39MAP() As Variant
    CODE39MAP = Array(Asc("0"), Asc("1"), Asc("2"), Asc("3"), Asc("4"), Asc("5"), Asc("6"), Asc("7"), Asc("8"), Asc("9"), Asc("A"), Asc("B"), Asc("C"), Asc("D"), Asc("E"), Asc("F"), Asc("G"), Asc("H"), Asc("I"), Asc("J"), Asc("K"), Asc("L"), Asc("M"), Asc("N"), Asc("O"), Asc("P"), Asc("Q"), Asc("R"), Asc("S"), Asc("T"), Asc("U"), Asc("V"), Asc("W"), Asc("X"), Asc("Y"), Asc("Z"), Asc("-"), Asc("."), Asc(" "), Asc("$"), Asc("/"), Asc("+"), Asc("%"))
   
    Dim RVal As Integer
    RVal = -1
    For x = 0 To (43 - 1)
        If CODE39MAP(x) = inputchar Then
            RVal = x
            Exit For
        End If
    Next x
    
    getCode39Value = RVal

End Function



Public Function filterInput_Code39(ByVal data As String) As String
  
  Dim Result As String
  Result = ""
  datalength = Len(data)

  Dim barcodechar As String
  For x = 0 To datalength - 1
        barcodechar = Mid(data, x + 1, 1)
        If getCode39Value(AscW(barcodechar)) <> -1 Then
            Result = Result & barcodechar
        End If
  Next x

  filterInput_Code39 = Result

End Function


Public Function getCode39Character(ByVal inputdecimal As Integer) As String

    Dim CODE39MAP() As Variant
    CODE39MAP = Array(Asc("0"), Asc("1"), Asc("2"), Asc("3"), Asc("4"), Asc("5"), Asc("6"), Asc("7"), Asc("8"), Asc("9"), Asc("A"), Asc("B"), Asc("C"), Asc("D"), Asc("E"), Asc("F"), Asc("G"), Asc("H"), Asc("I"), Asc("J"), Asc("K"), Asc("L"), Asc("M"), Asc("N"), Asc("O"), Asc("P"), Asc("Q"), Asc("R"), Asc("S"), Asc("T"), Asc("U"), Asc("V"), Asc("W"), Asc("X"), Asc("Y"), Asc("Z"), Asc("-"), Asc("."), Asc(" "), Asc("$"), Asc("/"), Asc("+"), Asc("%"))

    getCode39Character = CODE39MAP(inputdecimal)

End Function



Public Function generateCheckDigit_Code39(ByVal data As String) As String


  datalength = 0
  Sum = 0
  Result = -1
  strResult = ""
  Dim barcodechar As String
  
  datalength = Len(data)
  For x = 0 To datalength - 1
        barcodechar = Mid(data, x + 1, 1)
        Sum = Sum + getCode39Value(AscW(barcodechar))
        
  Next x
  
  Result = Sum Mod 43
  
  strResult = Chr(getCode39Character(Result))
  generateCheckDigit_Code39 = strResult

End Function

 

[OctaFish]

Als je de P niet wilt, kun je de variabele cd er toch uithalen? Of is dat te simpel?

    Result = "*" & FilteredData & "*"

 

[Hendrik2016]

Dank je wel. vraag beantwoord, probleem opgelost.

Dank je wel dat je er hebt naar willen kijken.
Ik ben er blij mee!