Code 39 VBA difficulties with line thickness - vba

Question

Dim a As String
a = Cells(1, 4).Value
y1 = 240
y2 = 270
x1 = 5
hakahaka = Cells(47, 20).Value
For st = 1 To 12
charr = Mid(hakahaka, st, 1)
If charr = 1 Then
Set myDocument = ActiveSheet '000czarny 255bialy'
With myDocument.Shapes.AddLine(x1, y1, x1, y2).Line
.Weight = 1
grubosc = 1
x1 = x1 + grubosc
.ForeColor.RGB = RGB(0, 0, 0)
End With
Else
Set myDocument = ActiveSheet '000czarny 255bialy'
With myDocument.Shapes.AddLine(x1, y1, x1, y2).Line
.Weight = 1
grubosc = 1
x1 = x1 + grubosc
.ForeColor.RGB = RGB(255, 255, 255)
End With
End If
Next st
For i = 1 To Len(a)
char = Mid(a, i, 1)
char = Int(char)
For k = 26 To 40
o = Cells(k, 13).Value
If o = char Then
kreski = Cells(k, 16).Value
For licz = 1 To 12
smiecie = Mid(kreski, licz, 1)
If smiecie = 1 Then
Set myDocument = ActiveSheet '000czarny 255bialy'
With myDocument.Shapes.AddLine(x1, y1, x1, y2).Line
.Weight = 1
grubosc = 1
x1 = x1 + grubosc
.ForeColor.RGB = RGB(0, 0, 0)
End With
Else
Set myDocument = ActiveSheet '000czarny 255bialy'
With myDocument.Shapes.AddLine(x1, y1, x1, y2).Line
.Weight = 1
grubosc = 1
x1 = x1 + grubosc
.ForeColor.RGB = RGB(255, 255, 255)
End With
End If
Next licz
End If
Next k
Next i
If i > Len(a) Then
hakahaka = Cells(47, 20).Value
For ts = 1 To 12
charr = Mid(hakahaka, ts, 1)
If charr = 1 Then
Set myDocument = ActiveSheet '000czarny 255bialy'
With myDocument.Shapes.AddLine(x1, y1, x1, y2).Line
.Weight = 1
grubosc = 1
x1 = x1 + grubosc
.ForeColor.RGB = RGB(0, 0, 0)
End With
Else
Set myDocument = ActiveSheet '000czarny 255bialy'
With myDocument.Shapes.AddLine(x1, y1, x1, y2).Line
.Weight = 1
grubosc = 1
x1 = x1 + grubosc
.ForeColor.RGB = RGB(255, 255, 255)
End With
End If
Next ts
End If
End Sub
Here is my cod that should generate code 39. I saw that there is problem with line thickness(grubosc) when there is black line next to white they are not next to each other because there is very thin gap between them is that possible that black line is thicker than white line despite the fact that i set weight of both lines to be 2?

Answer 1

here is a rewrite of your code (untested)
Option Explicit
Const y1 = 240
Const y2 = 270
Const vbCzarny = vbBlack
Const vbBialy = vbWhite
Sub test()
Dim x1 As Integer
x1 = 5
Dim a As String
a = Cells(1, 4).Value
x1 = doHakahaka(Cells(47, 20).Value, x1)
Dim char2 As String
Dim k As Integer
Dim i As Integer
For i = 1 To Len(a)
char2 = Mid(a, i, 1)
For k = 26 To 40
If Int(char2) = Cells(k, 13).Value Then
x1 = doHakahaka(Cells(k, 16).Value, x1)
End If
Next k
Next i
If i > Len(a) Then
x1 = doHakahaka(Cells(47, 20).Value, x1)
End If
End Sub
Function doHakahaka(hakahaka As String, x1 As Integer)
Dim lineColor As Long
Dim charr As String
Dim st As Integer
Dim grubosc As Integer
grubosc = 1
For st = 1 To 12
charr = Mid(hakahaka, st, 1)
If charr = 1 Then
lineColor = vbCzarny
Else
lineColor = vbBialy
End If
With ActiveSheet.Shapes.AddLine(x1, y1, x1, y2).Line
.Weight = 1
.ForeColor.RGB = lineColor
End With
x1 = x1 + grubosc
Next st
doHakahaka = x1
End Function

Answer 2

Ok finally it works i forgot about adding blank spaces between characters,thanks jsotola for help:)