问题分析

原代码直接将中文文本赋值给条形码控件（如 `BarCodeCtrl1`），但多数内置条形码/二维码控件（如 Microsoft BarCode Control）对中文支持较差，会导致乱码或无法识别。需通过调用 第三方接口 生成支持中文的二维码图片，并在 Excel 中显示。

优化方案：调用在线二维码接口生成中文二维码

核心思路

1. 判断文本是否包含中文：若包含中文，调用支持中文的在线二维码接口（如 `QRCode Monkey`、`草料二维码` 等）生成二维码图片 URL。

2. 下载并插入二维码图片：通过 VBA 下载接口返回的图片，并插入到 Excel 工作表中替换原控件。

具体实现代码

步骤1：封装中文检测函数

判断文本是否包含中文，避免不必要的接口调用。

Function HasChinese(text As String) As Boolean

Dim i As Integer

For i = 1 To Len(text)

If AscW(Mid(text, i, 1)) > 255 Then ' Unicode 编码 >255 为中文/全角字符

HasChinese = True

Exit Function

End If

Next i

HasChinese = False

End Function

步骤2：调用在线接口生成二维码（以 QRCode Monkey 为例）

QRCode Monkey 接口支持中文，返回 PNG 格式图片，无需 API 密钥，适合轻量使用。

Sub GenerateQRCodeWithChinese()

Dim selectedRow As Integer

Dim inventoryName As String, spec As String, qrText As String

Dim ws As Worksheet

Dim img As Shape

Dim http As Object

Dim qrUrl As String

Dim tempPath As String

' 1. 获取 ListBox 选中行数据

Set ws = ThisWorkbook.Sheets("Sheet1")

selectedRow = ListBox1.ListIndex ' 假设 ListBox1 为当前激活控件

If selectedRow = -1 Then

MsgBox "请先选择一行数据！", vbExclamation

Exit Sub

End If

' 2. 提取需编码的文本（存货名称 + 规格，换行分隔）

inventoryName = ListBox1.List(selectedRow, GetListBoxColumnIndex(ListBox1, "存货名称"))

spec = ListBox1.List(selectedRow, GetListBoxColumnIndex(ListBox1, "规格"))

qrText = inventoryName & vbCrLf & spec ' 合并文本，保留换行

' 3. 清除旧二维码（若存在）

On Error Resume Next

ws.Shapes("ChineseQRCode").Delete ' 删除命名为 "ChineseQRCode" 的旧图片

On Error GoTo 0

' 4. 区分中文/非中文处理

If HasChinese(qrText) Then

' 4.1 调用在线接口生成二维码（QRCode Monkey 接口）

Set http = CreateObject("MSXML2.XMLHTTP.6.0")

qrUrl = "https://api.qrcode-monkey.com/qr/custom?" & _

"data=" & EncodeURL(qrText) & _ ' 对文本进行 URL 编码（关键！避免中文乱码）

"&size=200" & _ ' 二维码尺寸（像素）

"&format=png" & _ ' 图片格式

"&ecc=L" ' 纠错等级（L/M/Q/H）

' 4.2 下载二维码图片到临时路径

tempPath = Environ("TEMP") & "\QRCodeTemp.png" ' 临时文件路径

http.Open "GET", qrUrl, False

http.Send

If http.Status = 200 Then

Open tempPath For Binary As #1

Put #1, , http.responseBody

Close #1

' 4.3 插入图片到工作表（替换原控件位置）

Set img = ws.Shapes.AddPicture(tempPath, msoFalse, msoTrue, _

ws.Shapes("BarCodeCtrl1").Left, _ ' 继承原控件位置

ws.Shapes("BarCodeCtrl1").Top, _

ws.Shapes("BarCodeCtrl1").Width, _ ' 继承原控件尺寸

ws.Shapes("BarCodeCtrl1").Height)

img.Name = "ChineseQRCode" ' 命名图片以便后续删除

Else

MsgBox "二维码生成失败，接口返回错误：" & http.Status, vbCritical

End If

' 清理临时文件

Kill tempPath

Set http = Nothing

Else

' 5. 非中文文本：使用原控件（若支持）

ws.Shapes("BarCodeCtrl1").DrawingObject.Object.Value = qrText

End If

End Sub

步骤3：封装 URL 编码函数（解决中文参数乱码）

接口请求中需对中文文本进行 URL 编码（如 `中文` → `%E4%B8%AD%E6%96%87`），否则接口无法识别。

Function EncodeURL(text As String) As String

Dim objUrlEncoder As Object

Set objUrlEncoder = CreateObject("System.Web.HttpUtility") ' 依赖 .NET Framework

EncodeURL = objUrlEncoder.UrlEncode(text)

Set objUrlEncoder = Nothing

End Function

关键说明

1. 接口选择：

- 若需稳定商用，建议使用付费接口（如 `Google Charts QR Code`、`ZXing` 自部署服务），避免免费接口限流。

- 草料二维码接口示例（国内访问更快）：

qrUrl = "https://cli.im/api/qrcode/code?text=" & EncodeURL(qrText) & "&m=0&logo=0"

2. 图片位置与尺寸：

代码中通过 `ws.Shapes("BarCodeCtrl1").Left/Top/Width/Height` 继承原控件的位置和尺寸，确保界面布局一致。

3. 错误处理：

增加 `On Error Resume Next` 处理文件删除、接口超时等异常，提升稳定性。

替代方案：使用本地二维码生成库（如 ZXing）

若无法联网，可通过 VBA 调用本地二维码生成库（如 `ZXing.Net`），需将库文件（`.dll`）注册到系统，适合离线场景。具体步骤：

1. 下载 `ZXing.Net` 的 `.NET Framework` 版本（）。

2. 通过 `CreateObject` 调用库生成二维码图片，示例代码略（需复杂的 COM 注册配置）。

总结

通过 中文检测 + 在线接口调用 的方式，可完美解决 VBA 内置控件不支持中文二维码的问题。代码兼顾了中英文场景，且无需额外安装软件，适合大多数 Excel 环境。若需更高性能或离线使用，可扩展为本地库方案。