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

这是我的鳕鱼应该生成代码39.我看到线条厚度（grubosc）存在问题，当白色旁边有黑线时它们彼此不相邻，因为它们之间的间隙非常小尽管我将两条线的重量设置为2？

，但黑线可能比白线更粗

Answer 1

这里是对代码的重写（未经测试）

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

好吧最后它的确有效我忘了在字符之间添加空格，感谢jsotola寻求帮助：）

Code 39 VBA线路厚度困难

2 个答案: