CODEWITHSUNDEEP
vba
Marcin
Marcin

Reputation: 45

Code 39 VBA difficulties with line thickness

 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?

Upvotes: 0

Views: 226

Answers (2)

Marcin
Marcin

Reputation: 45

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

Upvotes: 0

jsotola
jsotola

Reputation: 2278

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

Upvotes: 1

Related Questions