-1

我们正在实施代码以读取/创建开始出现在我们供应商零件上的二维条码。

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

对于 C#，建议使用开源库“ http://barcoderender.codeplex.com/ ”。关于这有多成功或是否有人有其他开源和/或付费选项的任何想法。

谢谢，

安东

4

2 回答 2

1

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

只需将“Microsoft Web Browser”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 的条款和服务。

于 2013-03-12T17:19:59.597 回答
0

我完全摆脱了网络浏览器控制和 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
于 2018-10-17T16:45:14.687 回答