«Transformer» un des champs du rapport Crystal Report en code barre

Un code barre est une police avec des codifications selon le type de code barre utilisé :

Code 39 : « * »+Champ+ « * »
Code 128 : algorithme permettant de transformer le champ

Il faut donc, pour l’un ou l’autre, utiliser un champ de formule comme vu précédemment :

C’est le champ de formule qu’il faudra positionner dans le rapport, et passer en police code 39 :

La formule du code barre 128 est fournie ici

Code 128 : copier-coller le texte ci-dessous dans une formule (type Visual Basic), il suffit de changer la variable d’entrée en gras et Crystal s’occupe du reste :

Dim dataString As String 'DO NOT CHANGE

'-------------------------------------------------------------------------------------------

' change the value below to the data you would like encoded

'-------------------------------------------------------------------------------------------

dataString = {DATA_DIAPASON/Entete.CodBarPal}

'-------------------------------------------------------------------------------------------

' DO NOT MODIFY ANY CODE BELOW THIS LINE

'-------------------------------------------------------------------------------------------

Dim workingString As String

Dim stringLength As Number

Dim currentChar As Number

Dim counter As Number

Dim firstChar, secondChar As String

Dim currentVariant, vB, vC As Number

Dim encodedString, holderString As String

Dim highAscii As Number

Dim offset As Number

Dim number1 As Boolean

holderString = ""

encodedString = ""

offset = 32

highAscii = 18

currentVariant = 0

vB = 1

vC = 2

workingString = dataString

stringLength = Len(workingString)

If stringLength = 0 Then

workingString = "NO DATA SPECIFIED"

End If

currentChar = 1

For counter = 1 To stringLength

If (currentChar = stringLength) Then

firstChar = Mid(workingString, currentChar, 1)

If (currentVariant = 0) Then

encodedString = ChrW(353)

currentVariant = vB

End If

If (currentVariant = vC) Then

encodedString = encodedString + ChrW(8211)

currentVariant = vB

End If

encodedString = encodedString + firstChar

currentChar = currentChar + 1

Else

Dim AsciiValue as Number

firstChar = Mid(workingString, currentChar, 1)

secondChar = Mid(workingString, currentChar + 1, 1)

number1 = (Asc(firstChar) >= 48 And Asc(firstChar) <= 57)

If (number1) Then

number1 = (Asc(secondChar) >= 48 And Asc(secondChar) <= 57)

End If

If (number1) Then

holderString = firstChar + secondChar

If (currentVariant = 0) Then

encodedString = ChrW(8250)

currentVariant = vC

End If

If (currentVariant = vB) Then

encodedString = encodedString + ChrW(8226)

currentVariant = vC

End If

Dim stringVal As Number

stringVal = Val(holderString)

If (stringVal = 0) Then

AsciiValue = 128

ElseIf (stringVal > 0 And stringVal < 95) Then

AsciiValue = stringVal + offset

Else

AsciiValue = stringVal + offset + highAscii

End If

stringVal = AsciiValue

Select Case stringVal

Case 128

holderString = ChrW(8364)

Case 32

holderString = ChrW(8364)

Case 145

holderString = ChrW(8216)

Case 146

holderString = ChrW(8217)

Case 147

holderString = ChrW(8220)

Case 148

holderString = ChrW(8221)

Case 149

holderString = ChrW(8226)

Case 150

holderString = ChrW(8211)

Case 151

holderString = ChrW(8212)

Case 152

holderString = ChrW(732)

Case 153

holderString = ChrW(8482)

Case 154

holderString = ChrW(353)

Case 155

holderString = ChrW(8250)

Case 156

holderString = ChrW(339)

Case Else

holderString = ChrW(AsciiValue)

End Select

encodedString = encodedString + holderString

currentChar = currentChar + 2

Else

firstChar = Mid(workingString, currentChar, 1)

If (currentVariant = 0) Then

encodedString = encodedString + ChrW(353)

currentVariant = vB

End If

If (currentVariant = vC) Then

encodedString = encodedString + ChrW(8211)

currentVariant = vB

End If

encodedString = encodedString + firstChar

currentChar = currentChar + 1

End If

If (currentChar > stringLength) Then

Exit For

End If

Dim totals As Number

Dim outsideCounter As Number

outsideCounter = 1

stringLength = Len(encodedString)

For counter = 1 To stringLength

firstChar = Mid(encodedString, counter, 1)

Dim charValue As Number

Select Case AscW(firstChar)

Case 8364

charValue = 32

Case 8216

charValue = 145

Case 8217

charValue = 146

Case 8220

charValue = 147

Case 8221

charValue = 148

Case 8226

charValue = 149

Case 8211

charValue = 150

Case 8212

charValue = 151

Case 732

charValue = 152

Case 8482

charValue = 153

Case 353

charValue = 154

Case 8250

charValue = 155

Case 339

charValue = 156

Case Else

charValue = AscW(firstChar)

End Select

If (charValue > 144) Then

totals = totals + ((charValue - offset - highAscii) * outsideCounter)

Else

totals = totals + ((charValue - offset) * outsideCounter)

End If

If (counter > 1) Then

outsideCounter = outsideCounter + 1

End If

If (totals = 0) Then

encodedString = encodedString + ChrW(8364)

Else

Dim absoluteTotal As Number

If (totals + offset) > 126 Then

absoluteTotal = totals + offset + highAscii

Else

absoluteTotal = totals + offset

End If

Select Case absoluteTotal

Case 128

holderString = ChrW(8364)

Case 32

holderString = ChrW(8364)

Case 145

holderString = ChrW(8216)

Case 146

holderString = ChrW(8217)

Case 147

holderString = ChrW(8220)

Case 148

holderString = ChrW(8221)

Case 149

holderString = ChrW(8226)

Case 150

holderString = ChrW(8211)

Case 151

holderString = ChrW(8212)

Case 152

holderString = ChrW(732)

Case 153

holderString = ChrW(8482)

Case 154

holderString = ChrW(353)

Case 155

holderString = ChrW(8250)

Case 156

holderString = ChrW(338)

Case Else

holderString = ChrW(absoluteTotal)

End Select

encodedString = encodedString + holderString

End If

encodedString = encodedString + ChrW(339)

formula = encodedString