Algo he conseguido.
Si ulilizo una fuente instalada no hay problema.
He encontrado este codigo que funciona, siempre que no esten los asteriscos en el codigo de barras. Si pongo asteriscos me lo saca asi con este simbolo ( por ejemplo el codigo 000002 sale (000002( no tengo ni idea por que.... El codigo del asterisco por lo que he visto es el correcto, lo remarco en el codigo. A alguno se os ocurre el porque???
Public Function FC_barcode3of9(ByVal strWord As String, _
ByVal strObj As Object)
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim pos As Integer
Dim Barcode As String
Dim Cur As String
Dim CurVal As Integer
Dim BC(0 To 43) As String
BC(0) = "000110100" '0
BC(1) = "100100001" '1
BC(2) = "001100001" '2
BC(3) = "101100000" '3
BC(4) = "000110001" '4
BC(5) = "100110000" '5
BC(6) = "001110000" '6
BC(7) = "000100101" '7
BC(8) = "100100100" '8
BC(9) = "001100100" '9
BC(10) = "100001001" 'A
BC(11) = "001001001" 'B
BC(12) = "101001000" 'C
BC(13) = "000011001" 'D
BC(14) = "100011000" 'E
BC(15) = "001011000" 'F
BC(16) = "000001101"
BC(17) = "100001100"
BC(18) = "001001100"
BC(19) = "000011100"
BC(20) = "100000011"
BC(21) = "001000011"
BC(22) = "101000010"
BC(23) = "000010011"
BC(24) = "100010010"
BC(25) = "001010010"
BC(26) = "000000111"
BC(27) = "100000110"
BC(28) = "001000110"
BC(29) = "000010110"
BC(30) = "110000001"
BC(31) = "011000001"
BC(32) = "111000000" 'W
BC(33) = "010010001" 'X
BC(34) = "110010000" 'Y
BC(35) = "011010000" 'Z
BC(36) = "010000101" '-
BC(37) = "110000100" '.
BC(38) = "011000100" '<spc>
BC(39) = "010101000" '$
BC(40) = "010100010" '/
BC(41) = "010001010" '+
BC(42) = "000101010" '%
BC(43) = "010010100" '* (used for start/stop character only)
strObj.Cls
pos = 20 '10
Barcode = UCase(strWord)
'Add Start & Stop characters?
'If Check1.value Then Barcode = "*" & Barcode & "*"
'If Check1.Value Then
Barcode = "*" & Barcode & "*"
'Generate Barcode
For x = 1 To Len(Barcode)
Cur = Mid$(Barcode, x, 1)
Select Case Cur
Case "0" To "9"
CurVal = Val(Cur)
Case "A" To "Z"
CurVal = Asc(Cur) - 55
Case "-"
CurVal = 36
Case "."
CurVal = 37
Case " "
CurVal = 38
Case "$"
CurVal = 39
Case "/"
CurVal = 40
Case "+"
CurVal = 41
Case "%"
CurVal = 42
Case "*"
CurVal = 43
Case Else 'oops!
strObj.Cls
strObj.Print Cur & " is Invalid"
Exit Function
End Select
For y = 1 To 9
If y / 2 = Int(y / 2) Then
'SPACE
pos = pos + 1 + (3 * Val(Mid$(BC(CurVal), y, 1)))
Else
'BAR
For z = 1 To 1 + (3 * Val(Mid$(BC(CurVal), y, 1)))
strObj.Line (pos, 1)-(pos, 50) ''strObj.Line (pos, 1)-(pos, 50)
pos = pos + 1
Next z
End If
Next y
pos = pos + 1 'make inter-character gap (ie: 1 narrow space)
Next x
'Add Label?
'If Check2.value = True Then 'false
' strObj.CurrentX = Len(Barcode) * 7 'kinda center
' strObj.Print Barcode
'End If
End Function 'BC