Context
我在用仅条形码 VBA 宏 https://code.google.com/archive/p/barcode-vba-macro-only/（在这个帖子 https://stackoverflow.com/a/31663859/669202）在 MS Excel 2010 中生成 QR 码。
（条形码将用于方便使用支付账单Girocode https://de.wikipedia.org/wiki/Girocode，但这在这里并不重要，只是说我需要完全按照下面所示的方式构造输入。）
问题
VBA 宏创建了很棒的 QR 代码，但不知何故，当给定某些输入时，输出（在 QR 代码中编码）会“结结巴巴”，即重复部分文本。
例如，当给出以下输入时：
BCD
001
1
SCT
SOLADES1HDB
Recipient First and Last Name
DE86672500200000123456
EUR123.45
它产生这样的输出：
奇怪的是重复了部分内容：
BCD
001
1
SCT
SOLADES1HDB
Recipient First and Last Name
DE
Recipient First and Last Name
DE86672500200000123456
EUR123.45
（注意DE和线收件人的名字和姓氏出现两次。）
我想要的是
Excel 中的可用、免费/GPL 解决方案可生成此类代码；-) ...例如，通过了解发生这种情况的原因并修复 VBA 代码。
我尝试过的（更新1）
我尝试过不同的输入，发现只需在长数字的末尾添加一些额外的“AAA”就可以解决口吃问题……所以我很好奇是什么原因导致了这种情况。
我在 GitHub 上分叉代码，添加了一些代码注释并翻译了一些现有的（捷克语）注释
通过一些调试，我发现该实现搞乱了不同编码的起始位置（它存储在数组中）eb）：将“收件人名字和姓氏”（包括换行符和“DE”）编码为“字节”后，它可能会尝试切换到“十进制”或“字母”编码（每个字符仅 3.33 或 5.5 位，而不是 8 位）。 ..但随后又回到“字节”格式编码，从而导致起始位置错误。
The code
您可以下载我的测试 XLSM 文件here https://app.box.com/s/6i2ih68i5o07w3xu8oc3q6iulexagx9p，并访问我的GitHub 上改进的代码文件 https://github.com/JonasHeidelberg/barcode-vba-macro-only/blob/Excel/barcody.bas.
我认为问题可能出在下面所示的核心函数中，在数组所在的部分中eb()充满。
Function qr_gen(ptext As String, poptions As String) As String
Dim encoded1() As Byte ' byte mode (ASCII) all max 3200 bytes
Dim encix1%
Dim ecx_cnt(3) As Integer
Dim ecx_pos(3) As Integer
Dim ecx_poc(3) As Integer
Dim eb(1 To 20, 1 To 4) As Integer 'store how many characters should be in which ECI mode. This is a list of rows, each row corresponding a the next batch of characters with a different ECI mode.
' eb(i, 1) - ECI mode (1 = numeric, 2 = alphanumeric, 3 = byte)
' eb(i, 2) - last character in previous row
' eb(i, 3) - number of characters in THIS row
' eb(i, 4) - number of bits for THIS row
Dim ascimatrix$, mode$, err$
Dim ecl%, r%, c%, mask%, utf8%, ebcnt%
Dim i&, j&, k&, m&
Dim ch%, s%, siz%
Dim x As Boolean
Dim qrarr() As Byte ' final matrix
Dim qrpos As Integer
Dim qrp(15) As Integer ' 1:version,2:size,3:ccs,4:ccb,5:totby,6-12:syncs(7),13-15:versinfo(3)
Dim qrsync1(1 To 8) As Byte
Dim qrsync2(1 To 5) As Byte
ascimatrix = ""
err = ""
mode = "M"
i = InStr(poptions, "mode=")
If i > 0 Then mode = Mid(poptions, i + 5, 1)
' M=0,L=1,H=2,Q=3
ecl = InStr("MLHQ", mode) - 1
If ecl < 0 Then mode = "M": ecl = 0
If ptext = "" Then
err = "Not data"
Exit Function
End If
For i = 1 To 3
ecx_pos(i) = 0
ecx_cnt(i) = 0
ecx_poc(i) = 0
Next i
ebcnt = 1
utf8 = 0
For i = 1 To Len(ptext) + 1
' Decide how many bytes this character has
If i > Len(ptext) Then
k = -5 ' End of text --> skip several code sections
Else ' need to parse character i of ptext and decide how many bytes it has
k = AscL(Mid(ptext, i, 1))
If k >= &H1FFFFF Then ' FFFF - 1FFFFFFF
m = 4
k = -1
ElseIf k >= &H7FF Then ' 7FF-FFFF 3 bytes
m = 3
k = -1
ElseIf k >= 128 Then
m = 2
k = -1
Else ' normal 7bit ASCII character, so it is worth it to check if it belong to the Numeric or Alphanumeric subsets defined in ECI (array qralnum)
m = 1
k = InStr(qralnum, Mid(ptext, i, 1)) - 1
End If
End If
' Depending on k and a lot of other things, increase ebcnt
If (k < 0) Then ' Treat mult-byte case or exit? (bude byte nebo konec)
If ecx_cnt(1) >= 9 Or (k = -5 And ecx_cnt(1) = ecx_cnt(3)) Then ' Until now it was possible numeric??? (Az dosud bylo mozno pouzitelne numeric)
If (ecx_cnt(2) - ecx_cnt(1)) >= 8 Or (ecx_cnt(3) = ecx_cnt(2)) Then ' pred num je i pouzitelny alnum
If (ecx_cnt(3) > ecx_cnt(2)) Then ' Jeste pred alnum bylo byte
eb(ebcnt, 1) = 3 ' Typ byte
eb(ebcnt, 2) = ecx_pos(3) ' Position pozice
eb(ebcnt, 3) = ecx_cnt(3) - ecx_cnt(2) ' delka
ebcnt = ebcnt + 1
ecx_poc(3) = ecx_poc(3) + 1
End If
eb(ebcnt, 1) = 2 ' Typ alnum
eb(ebcnt, 2) = ecx_pos(2)
eb(ebcnt, 3) = ecx_cnt(2) - ecx_cnt(1) ' delka
ebcnt = ebcnt + 1
ecx_poc(2) = ecx_poc(2) + 1
ecx_cnt(2) = 0
ElseIf ecx_cnt(3) > ecx_cnt(1) Then ' byly bytes pred numeric
eb(ebcnt, 1) = 3 ' Typ byte
eb(ebcnt, 2) = ecx_pos(3) ' Position pozice
eb(ebcnt, 3) = ecx_cnt(3) - ecx_cnt(1) ' delka
ebcnt = ebcnt + 1
ecx_poc(3) = ecx_poc(3) + 1
End If
ElseIf (ecx_cnt(2) >= 8) Or (k = -5 And ecx_cnt(2) = ecx_cnt(3)) Then ' Az dosud bylo mozno pouzitelne alnum
If (ecx_cnt(3) > ecx_cnt(2)) Then ' Jeste pred alnum bylo byte
eb(ebcnt, 1) = 3 ' Typ byte
eb(ebcnt, 2) = ecx_pos(3) ' Position pozice
eb(ebcnt, 3) = ecx_cnt(3) - ecx_cnt(2) ' delka
ebcnt = ebcnt + 1
ecx_poc(3) = ecx_poc(3) + 1
End If
eb(ebcnt, 1) = 2 ' Typ alnum
eb(ebcnt, 2) = ecx_pos(2)
eb(ebcnt, 3) = ecx_cnt(2) ' delka
ebcnt = ebcnt + 1
ecx_poc(2) = ecx_poc(2) + 1
ecx_cnt(3) = 0
ecx_cnt(2) = 0 ' vse zpracovano
ElseIf (k = -5 And ecx_cnt(3) > 0) Then ' konec ale mam co ulozit
eb(ebcnt, 1) = 3 ' Typ byte
eb(ebcnt, 2) = ecx_pos(3) ' Position pozice
eb(ebcnt, 3) = ecx_cnt(3) ' delka
ebcnt = ebcnt + 1
ecx_poc(3) = ecx_poc(3) + 1
End If
End If
If k = -5 Then Exit For
If (k >= 0) Then ' We can alphanumeric? (Muzeme alnum)
If (k >= 10 And ecx_cnt(1) >= 12) Then ' Until now it was perhaps numeric (Az dosud bylo mozno num)
If (ecx_cnt(2) - ecx_cnt(1)) >= 8 Or (ecx_cnt(3) = ecx_cnt(2)) Then ' There is also an alphanumeric which is worth it(Je tam i alnum ktery stoji za to)
If (ecx_cnt(3) > ecx_cnt(2)) Then ' Even before it was alnum byte (Jeste pred alnum bylo byte)
eb(ebcnt, 1) = 3 ' Typ byte
eb(ebcnt, 2) = ecx_pos(3) ' Position (pozice)
eb(ebcnt, 3) = ecx_cnt(3) - ecx_cnt(2) ' length (delka)
ebcnt = ebcnt + 1
ecx_poc(3) = ecx_poc(3) + 1
End If
eb(ebcnt, 1) = 2 ' Typ alnum
eb(ebcnt, 2) = ecx_pos(2)
eb(ebcnt, 3) = ecx_cnt(2) - ecx_cnt(1) ' length (delka)
ebcnt = ebcnt + 1
ecx_poc(2) = ecx_poc(2) + 1
ecx_cnt(2) = 0 ' processed everything (vse zpracovano)
ElseIf (ecx_cnt(3) > ecx_cnt(1)) Then ' Previous Num is byte (Pred Num je byte)
eb(ebcnt, 1) = 3 ' Typ byte
eb(ebcnt, 2) = ecx_pos(3) ' Position (pozice)
eb(ebcnt, 3) = ecx_cnt(3) - ecx_cnt(1) ' length (delka)
ebcnt = ebcnt + 1
ecx_poc(3) = ecx_poc(3) + 1
End If
eb(ebcnt, 1) = 1 ' Typ numerix
eb(ebcnt, 2) = ecx_pos(1)
eb(ebcnt, 3) = ecx_cnt(1) ' length (delka)
ebcnt = ebcnt + 1
ecx_poc(1) = ecx_poc(1) + 1
ecx_cnt(1) = 0
ecx_cnt(2) = 0
ecx_cnt(3) = 0 ' processed everything (vse zpracovano)
End If
If ecx_cnt(2) = 0 Then ecx_pos(2) = i
ecx_cnt(2) = ecx_cnt(2) + 1
Else ' possible alnum (mozno alnum)
ecx_cnt(2) = 0
End If
If k >= 0 And k < 10 Then ' Can be numeric (muze byt numeric)
If ecx_cnt(1) = 0 Then ecx_pos(1) = i
ecx_cnt(1) = ecx_cnt(1) + 1
Else
ecx_cnt(1) = 0
End If
If ecx_cnt(3) = 0 Then ecx_pos(3) = i
ecx_cnt(3) = ecx_cnt(3) + m
utf8 = utf8 + m
If ebcnt >= 16 Then ' We have already taken 3 other blocks of bits (Uz by se mi tri dalsi bloky stejne nevesli)
ecx_cnt(1) = 0
ecx_cnt(2) = 0
End If
Debug.Print "Character:'" & Mid(ptext, i, 1) & "'(" & k & _
") ebn=" & ecx_pos(1) & "." & ecx_cnt(1) & _
" eba=" & ecx_pos(2) & "." & ecx_cnt(2) & _
" ebb=" & ecx_pos(3) & "." & ecx_cnt(3)
Next
ebcnt = ebcnt - 1 ' ebcnt now has its final value
Debug.Print ("ebcnt=" & ebcnt)
c = 0
For i = 1 To ebcnt
Select Case eb(i, 1)
Case 1: eb(i, 4) = Int(eb(i, 3) / 3) * 10 + (eb(i, 3) Mod 3) * 3 + IIf((eb(i, 3) Mod 3) > 0, 1, 0)
Case 2: eb(i, 4) = Int(eb(i, 3) / 2) * 11 + (eb(i, 3) Mod 2) * 6
Case 3: eb(i, 4) = eb(i, 3) * 8
End Select
c = c + eb(i, 4)
Next i
Debug.Print ("c=" & c)
' UTF-8 is default not need ECI value - zxing cannot recognize
' Call qr_params(i * 8 + utf8,mode,qrp)
Call qr_params(c, ecl, qrp, ecx_poc)
If qrp(1) <= 0 Then
err = "Too long"
Exit Function
End If
siz = qrp(2)
Debug.Print "ver:" & qrp(1) & mode & " size " & siz & " ecc:" & qrp(3) & "x" & qrp(4) & " d:" & (qrp(5) - qrp(3) * qrp(4))
'MsgBox "ver:" & qrp(1) & mode & " size " & siz & " ecc:" & qrp(3) & "x" & qrp(4) & " d:" & (qrp(5) - qrp(3) * qrp(4))
ReDim encoded1(qrp(5) + 2)
' Table 3 — Number of bits in character count indicator for QR Code 2005:
' mode indicator (1=num,2=AlNum,4=Byte,8=kanji,ECI=7)
' mode: Byte Alphanum Numeric Kanji
' ver 1..9 : 8 9 10 8
' 10..26 : 16 11 12 10
' 27..40 : 16 13 14 12
' UTF-8 is default not need ECI value - zxing cannot recognize
' if utf8 > 0 Then
' k = &H700 + 26 ' UTF-8=26 ; Win1250 = 21; 8859-2 = 4 viz http://strokescribe.com/en/ECI.html
' bb_putbits(encoded1,encix1,k,12)
' End If
encix1 = 0
For i = 1 To ebcnt
Select Case eb(i, 1)
Case 1: c = IIf(qrp(1) < 10, 10, IIf(qrp(1) < 27, 12, 14)): k = 2 ^ c + eb(i, 3) ' encoding mode "Numeric"
Case 2: c = IIf(qrp(1) < 10, 9, IIf(qrp(1) < 27, 11, 13)): k = 2 * (2 ^ c) + eb(i, 3) ' encoding mode "alphanum
Case 3: c = IIf(qrp(1) < 10, 8, 16): k = 4 * (2 ^ c) + eb(i, 3) ' encoding mode "Byte"
End Select
Call bb_putbits(encoded1, encix1, k, c + 4)
Debug.Print "ver:" & qrp(1) & mode & " size " & siz & " ecc:" & qrp(3) & "x" & qrp(4) & " d:" & (qrp(5) - qrp(3) * qrp(4))
j = 0 ' count characters that have been output in THIS row eb(i,...)
m = eb(i, 2) 'Start (after) last character of input from previous row
r = 0
While j < eb(i, 3)
k = AscL(Mid(ptext, m, 1))
m = m + 1
If eb(i, 1) = 1 Then
' parse numeric input - output 3 decimal digits into 10 bit
r = (r * 10) + ((k - &H30) Mod 10)
If (j Mod 3) = 2 Then
Call bb_putbits(encoded1, encix1, r, 10)
r = 0
End If
j = j + 1
ElseIf eb(i, 1) = 2 Then
' parse alphanumeric input - output 2 alphanumeric characters into 11 bit
r = (r * 45) + ((InStr(qralnum, Chr(k)) - 1) Mod 45)
If (j Mod 2) = 1 Then
Call bb_putbits(encoded1, encix1, r, 11)
r = 0
End If
j = j + 1
Else
' Okay, byte mode: coding according to Chapter "6.4.2 Extended Channel Interpretation (ECI) mode" of ISOIEC 18004_2006Cor 1_2009.pdf
If k > &H1FFFFF Then ' FFFF - 1FFFFFFF
ch = &HF0 + Int(k / &H40000) Mod 8
Call bb_putbits(encoded1, encix1, ch, 8)
ch = 128 + Int(k / &H1000) Mod 64
Call bb_putbits(encoded1, encix1, ch, 8)
ch = 128 + Int(k / 64) Mod 64
Call bb_putbits(encoded1, encix1, ch, 8)
ch = 128 + k Mod 64
Call bb_putbits(encoded1, encix1, ch, 8)
j = j + 4
ElseIf k > &H7FF Then ' 7FF-FFFF 3 bytes
ch = &HE0 + Int(k / &H1000) Mod 16
Call bb_putbits(encoded1, encix1, ch, 8)
ch = 128 + Int(k / 64) Mod 64
Call bb_putbits(encoded1, encix1, ch, 8)
ch = 128 + k Mod 64
Call bb_putbits(encoded1, encix1, ch, 8)
j = j + 3
ElseIf k > &H7F Then ' 2 bytes
ch = &HC0 + Int(k / 64) Mod 32
Call bb_putbits(encoded1, encix1, ch, 8)
ch = 128 + k Mod 64
Call bb_putbits(encoded1, encix1, ch, 8)
j = j + 2
Else
ch = k Mod 256
Call bb_putbits(encoded1, encix1, ch, 8)
j = j + 1
End If
End If
Wend
Select Case eb(i, 1)
Case 1:
If (j Mod 3) = 1 Then
Call bb_putbits(encoded1, encix1, r, 4)
ElseIf (j Mod 3) = 2 Then
Call bb_putbits(encoded1, encix1, r, 7)
End If
Case 2:
If (j Mod 2) = 1 Then Call bb_putbits(encoded1, encix1, r, 6)
End Select
'MsgBox "blk[" & i & "] t:" & eb(i,1) & "from " & eb(i,2) & " to " & eb(i,3) + eb(i,2) & " bits=" & encix1
Next i
Call bb_putbits(encoded1, encix1, 0, 4) ' end of chain
If (encix1 Mod 8) <> 0 Then ' round to byte
Call bb_putbits(encoded1, encix1, 0, 8 - (encix1 Mod 8))
End If
' padding
i = (qrp(5) - qrp(3) * qrp(4)) * 8
If encix1 > i Then
err = "Encode length error"
Exit Function
End If
' padding 0xEC,0x11,0xEC,0x11...
Do While encix1 < i
Call bb_putbits(encoded1, encix1, &HEC11, 16)
Loop
' doplnime ECC
i = qrp(3) * qrp(4) 'ppoly, pmemptr , psize , plen , pblocks
Call qr_rs(&H11D, encoded1, qrp(5) - i, i, qrp(4))
'Call arr2hexstr(encoded1)
encix1 = qrp(5)
' Pole pro vystup
ReDim qrarr(0)
ReDim qrarr(1, qrp(2) * 24& + 24&) ' 24 bytes per row
qrarr(0, 0) = 0
ch = 0
Call bb_putbits(qrsync1, ch, Array(&HFE, &H82, &HBA, &HBA, &HBA, &H82, &HFE, 0), 64)
Call qr_mask(qrarr, qrsync1, 8, 0, 0) ' sync UL
Call qr_mask(qrarr, 0, 8, 8, 0) ' fmtinfo UL under - bity 14..9 SYNC 8
Call qr_mask(qrarr, qrsync1, 8, 0, siz - 7) ' sync UR ( o bit vlevo )
Call qr_mask(qrarr, 0, 8, 8, siz - 8) ' fmtinfo UR - bity 7..0
Call qr_mask(qrarr, qrsync1, 8, siz - 7, 0) ' sync DL (zasahuje i do quiet zony)
Call qr_mask(qrarr, 0, 8, siz - 8, 0) ' blank nad DL
For i = 0 To 6
x = qr_bit(qrarr, -1, i, 8, 0) ' svisle fmtinfo UL - bity 0..5 SYNC 6,7
x = qr_bit(qrarr, -1, i, siz - 8, 0) ' svisly blank pred UR
x = qr_bit(qrarr, -1, siz - 1 - i, 8, 0) ' svisle fmtinfo DL - bity 14..8
Next
x = qr_bit(qrarr, -1, 7, 8, 0) ' svisle fmtinfo UL - bity 0..5 SYNC 6,7
x = qr_bit(qrarr, -1, 7, siz - 8, 0) ' svisly blank pred UR
x = qr_bit(qrarr, -1, 8, 8, 0) ' svisle fmtinfo UL - bity 0..5 SYNC 6,7
x = qr_bit(qrarr, -1, siz - 8, 8, 1) ' black dot DL
If qrp(13) <> 0 Or qrp(14) <> 0 Then ' versioninfo
' UR ver 0 1 2;3 4 5;...;15 16 17
' LL ver 0 3 6 9 12 15;1 4 7 10 13 16; 2 5 8 11 14 17
k = 65536 * qrp(13) + 256& * qrp(14) + 1& * qrp(15)
c = 0: r = 0
For i = 0 To 17
ch = k Mod 2
x = qr_bit(qrarr, -1, r, siz - 11 + c, ch) ' UR ver
x = qr_bit(qrarr, -1, siz - 11 + c, r, ch) ' DL ver
c = c + 1
If c > 2 Then c = 0: r = r + 1
k = Int(k / 2&)
Next
End If
c = 1
For i = 8 To siz - 9 ' sync lines
x = qr_bit(qrarr, -1, i, 6, c) ' vertical on column 6
x = qr_bit(qrarr, -1, 6, i, c) ' horizontal on row 6
c = (c + 1) Mod 2
Next
' other syncs
ch = 0
Call bb_putbits(qrsync2, ch, Array(&H1F, &H11, &H15, &H11, &H1F), 40)
ch = 6
Do While ch > 0 And qrp(6 + ch) = 0
ch = ch - 1
Loop
If ch > 0 Then
For c = 0 To ch
For r = 0 To ch
' corners
If (c <> 0 Or r <> 0) And _
(c <> ch Or r <> 0) And _
(c <> 0 Or r <> ch) Then
Call qr_mask(qrarr, qrsync2, 5, qrp(r + 6) - 2, qrp(c + 6) - 2)
End If
Next r
Next c
End If
' qr_fill(parr as Variant, psiz%, pb as Variant, pblocks%, pdlen%, ptlen%)
' vyplni pole parr (psiz x 24 bytes) z pole pb pdlen = pocet dbytes, pblocks = bloku, ptlen celkem
Call qr_fill(qrarr, siz, encoded1, qrp(4), qrp(5) - qrp(3) * qrp(4), qrp(5))
mask = 8 ' auto
i = InStr(poptions, "mask=")
If i > 0 Then mask = val(Mid(poptions, i + 5, 1))
If mask < 0 Or mask > 7 Then
j = -1
For mask = 0 To 7
GoSub addmm
i = qr_xormask(qrarr, siz, mask, False)
' MsgBox "score mask " & mask & " is " & i
If i < j Or j = -1 Then j = i: s = mask
Next mask
mask = s
' MsgBox "best is " & mask & " with score " & j
End If
GoSub addmm
i = qr_xormask(qrarr, siz, mask, True)
ascimatrix = ""
For r = 0 To siz Step 2
s = 0
For c = 0 To siz Step 2
If (c Mod 8) = 0 Then
ch = qrarr(1, s + 24 * r)
If r < siz Then i = qrarr(1, s + 24 * (r + 1)) Else i = 0
s = s + 1
End If
ascimatrix = ascimatrix _
& Chr(97 + (ch Mod 4) + 4 * (i Mod 4))
ch = Int(ch / 4)
i = Int(i / 4)
Next
ascimatrix = ascimatrix & vbNewLine
Next r
ReDim qrarr(0)
qr_gen = ascimatrix
Exit Function
addmm:
k = ecl * 8 + mask
' poly: 101 0011 0111
Call qr_bch_calc(k, &H537)
'MsgBox "mask :" & hex(k,3) & " " & hex(k xor &H5412,3)
k = k Xor &H5412 ' micro xor &H4445
r = 0
c = siz - 1
For i = 0 To 14
ch = k Mod 2
k = Int(k / 2)
x = qr_bit(qrarr, -1, r, 8, ch) ' svisle fmtinfo UL - bity 0..5 SYNC 6,7 .... 8..14 dole
x = qr_bit(qrarr, -1, 8, c, ch) ' vodorovne odzadu 0..7 ............ 8,SYNC,9..14
c = c - 1
r = r + 1
If i = 7 Then c = 7: r = siz - 7
If i = 5 Then r = r + 1 ' preskoc sync vodorvny
If i = 8 Then c = c - 1 ' preskoc sync svisly
Next
Return
End Function ' qr_gen
