No se si es lo q necesitas, yo lo hago de la siguiente manera.
Genero el código y le envio a la funcion "codificar odigo de barras"
CODIGOL = codificarCodigoBarras("xxxxxxxx" & Format(Now.Day, "00") & Format(Now.Month, "00") & Mid(Now.Year, 4, 1) & Mid(Trim(Dgseleccionados.Item(i, 3)), 1, 8), 1)
Public Function codificarCodigoBarras(ByVal BarTextIn As String, ByVal Subset As Integer) As String
' Initialize input and output strings
' la funcion se llama con lo siguiente codificarCodigoBarras([refcorreos];1)
Dim BarTextOut, StartChar, BarCodeOut, CheckSum As String
Dim Sum, II, ThisChar, CharValue, CheckSumValue As Long
BarTextOut = ""
BarTextIn = Trim(BarTextIn)
' Set up for the subset we are in
If Subset = 0 Then
Sum = 103
StartChar = "{"
Else
Sum = 104
StartChar = "|"
End If
' Calculate the checksum, mod 103 and build output string
For II = 1 To Len(BarTextIn)
'Find the ASCII value of the current character
ThisChar = (Asc(Mid(BarTextIn, II, 1)))
'Calculate the bar code 128 value
If ThisChar < 123 Then
CharValue = ThisChar - 32
Else
CharValue = ThisChar - 70
End If
'add this value to sum for checksum work
Sum = Sum + (CharValue * II)
'Now work on output string, no spaces in TrueType fonts
If Mid(BarTextIn, II, 1) = " " Then
BarTextOut = BarTextOut & Chr(174)
Else
BarTextOut = BarTextOut & Mid(BarTextIn, II, 1)
End If
Next II
' Find the remainder when Sum is divided by 103
CheckSumValue = (Sum Mod 103)
' Translate that value to an ASCII character
If CheckSumValue > 90 Then
CheckSum = Chr(CheckSumValue + 70)
ElseIf CheckSumValue > 0 Then
CheckSum = Chr(CheckSumValue + 32)
Else
CheckSum = Chr(174)
End If
'Build ouput string, trailing space is for Windows rasterization bug
BarCodeOut = StartChar & BarTextOut & CheckSum & "~ "
'Return the string
codificarCodigoBarras = BarCodeOut
End Function
