Ms access 在MS Access报告/表格中创建2D（数据矩阵或QR代码）

我们正在实施代码，以读取/创建开始显示在供应商零件上的二维条形码

我们需要在MS Access报告和表单中创建二维条形码。有人成功地使用了字体（IDAutomation）或Active X（dlSoft）解决方案吗

对于C#，建议使用开源库“”。有没有关于这有多成功的想法，或者是否有人有其他开源和/或付费选择

谢谢

---

Anton

根据需要生成的代码量，您可以使用Google Charts API生成二维码

只需将“Microsoft Web浏览器”ActiveX组件和以下代码添加到表单中：

Dim Size As Integer
Dim Text As String
Dim URL As String
Size = 200
Text = "This is my test"
' Better to actually use a URL encoding function like those described here:
' http://stackoverflow.com/questions/218181/how-can-i-url-encode-a-string-in-excel-vba
Text = Replace(Text, " ", "%20")
URL = "http://chart.apis.google.com/chart?chs=" & Size & "x" & Size & "&cht=qr&chld=H|0&chl=" & Text
WebBrowser.Navigate (URL)

当然，您可以根据需要更改大小和文本。文本也可以是直接来自表单的值，因此也可以是数据

---

我建议您在使用之前检查Google的条款和服务。

我完全没有使用web浏览器控件和Google API，因为我可以告诉您，该功能现在已经不推荐使用了。我使用了不同的免费API，但可以使用Google API或任何其他API

在我的示例中，我在与应用程序相同的目录中创建一个.png图像。我的表单上有一个名为txtToCode的文本框，我可以在其中键入任何要编码的文本。我还有一个图像控件，这样可以从表单中查看图像，但您可以按照自己的意愿对其进行修改：

Private Sub btnCode2_Click()
     Call GetQRCode(Me.txtToCode, 150, 150)
End Sub

Sub GetQRCode(Content As String, Width As Integer, Height As Integer)
    Dim ByteData() As Byte
    Dim XmlHttp As Object
    Dim HttpReq As String
    Dim ReturnContent As String
    Dim EncContent As String
    Dim QRImage As String
    EncContent = EncodeURL(Content)

    HttpReq = "https://api.qrserver.com/v1/create-qr-code/?data=" & EncContent & "&size=" & Width & "x" & Height & ""

    Set XmlHttp = CreateObject("MSXML2.XmlHttp")
    XmlHttp.Open "GET", HttpReq, False
    XmlHttp.Send
    ByteData = XmlHttp.responseBody
    Set XmlHttp = Nothing

    ReturnContent = StrConv(ByteData, vbUnicode)
    Call ExportImage(ReturnContent)
End Sub

Private Sub ExportImage(image As String)
    Dim FilePath As String

    On Error GoTo NoSave

    ' Build Export Path
    FilePath = Application.CurrentProject.Path & "\qr.png"


    Open FilePath For Binary As #1
       Put #1, 1, image
    Close #1
    Me.Image3.Picture = FilePath
    ' Save File Path
    Exit Sub
NoSave:
MsgBox "Could not save the QR Code Image! Reason: " & Err.Description, vbCritical, "File Save Error"
End Sub

Private Function EncodeURL(str As String)
    Dim ScriptEngine As Object
    Dim encoded As String
    Dim Temp As String

    Temp = Replace(str, " ", "%20")
    Temp = Replace(Temp, "#", "%23")
    EncodeURL = Temp
End Function

---

您好，您能帮助生成多行

二维码吗。表示一行，然后是第一行下的新行。@Harun24HR我们使用了一个带有打印标签的图像控件的报告，做了类似的事情。我基于上述代码构建了一个函数，并在报告的recordsource中使用它为每个行项目生成二维码。