Блог

мой последний вопрос был удален. тем не менее, люди ответили, спасибо, и я последовал их советам. Я нашел время, чтобы сделать это из-за праздников и Covid. У меня все еще есть одна проблема, которую я хотел бы изложить.

с помощью библиотеки QRCodeLib.xlam я создаю безупречный qr-код… к сожалению, я не могу вызвать его из Access. смотрите Код доступа ниже :

     Public Sub GenQRCode()


Dim gxlApp      As Excel.Application
Dim gxlWB       As Workbook
Dim PAYLOAD_1   As String   ' chaîne de caractères à coder
Dim strFile     As String

strFile = "D:QRCodeLibVBA-masterQRCodeLibDemo.xlsm"
PAYLOAD_1 = "SPC" amp; vbCrLf amp; _
        "0200" amp; vbCrLf amp; _
        "1" amp; vbCrLf amp; _
        "CH4431999123000889012" amp; vbCrLf amp; _
        "S" amp; vbCrLf amp; _
        "Robert Schneider AG" amp; vbCrLf amp; _
        "Via Casa Postale" amp; vbCrLf amp; "1268" amp; vbCrLf amp; _
        "2501" amp; vbCrLf amp; "Biel" amp; vbCrLf amp; _
        "CH" amp; vbCrLf amp; _
        vbCrLf amp; vbCrLf amp; vbCrLf amp; vbCrLf amp; vbCrLf amp; vbCrLf amp; vbCrLf amp; _
        "123949.75" amp; vbCrLf amp; _
        "CHF" amp; vbCrLf amp; _
        "S" amp; vbCrLf amp; _
        "Pia-Maria Rutschmann-Schnyder" amp; vbCrLf amp; _
        "Grosse Marktgasse" amp; vbCrLf amp; "28/5" amp; vbCrLf amp; _
        "9400" amp; vbCrLf amp; "Rorschach" amp; vbCrLf amp; _
        "CH" amp; vbCrLf amp; _
        "QRR" amp; vbCrLf amp; "210000000003139471430009017" amp; vbCrLf amp; _
        "Beachten sie unsere Sonderangebotswoche bis 23.02.2017!" amp; vbCrLf amp; _
        "EPD" amp; vbCrLf amp; "//S1/10/10201409/11/181105/40/0:30" amp; vbCrLf amp; _
        "eBill/B/41010560425610173"
        
Set gxlApp = CreateObject("Excel.Application")
gxlApp.Visible = True
Set gxlWB = gxlApp.Workbooks.Open(strFile, False, False)
With gxlWB
    .gettxt (PAYLOAD_1)
    .qrCode
End With
If Not (gxlWB Is Nothing) Then
    gxlWB.Close False
End If
If Not (gxlApp Is Nothing) Then
    gxlApp.Quit
End If
Set gxlWB = Nothing
Set gxlApp = Nothing

    End Sub
 

с сайтом https://api.qrserver.com/v1/create-qr-code /, Мне удается создать qr-код в Access… но все разрывы строк удаляются из результата. см. Код формы доступа ниже. Я создаю форму для создания qr-кода и отчета для его отображения.

     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=" amp; EncContent amp; "amp;size=" amp; Width amp; "x" amp; Height amp; ""

        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

    Sub ExportImage(image As String)

        On Error GoTo NoSave    
        m_FilePath = Application.CurrentProject.Path amp; "qr.png"
        Open m_FilePath For Binary As #1
        Put #1, 1, image
        Close #1
       ' Build Export Path
       DoCmd.OpenReport "Table1", acViewPreview

    Exit Sub
   NoSave:
     MsgBox "Could not save the QR Code Image! Reason: " amp; 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, " ", " ")
        Temp = Replace(Temp, "#", "#")
        EncodeURL = Temp
    End Function

    Private Sub Form_Load()
        Me.txtToCode.Value = "SPC" amp; vbCrLf amp; _
            "0200" amp; vbCrLf amp; _
            "1" amp; vbCrLf amp; _
            "CH4431999123000889012" amp; vbCrLf amp; _
            "S" amp; vbCrLf amp; _
            "Robert Schneider AG" amp; vbCrLf amp; _
            "Via Casa Postale" amp; vbCrLf amp; "1268" amp; vbCrLf amp; _
            "2501" amp; vbCrLf amp; "Biel" amp; vbCrLf amp; _
            "CH" amp; vbCrLf amp; _
            vbCrLf amp; vbCrLf amp; vbCrLf amp; vbCrLf amp; vbCrLf amp; vbCrLf amp; vbCrLf amp; _
            "123949.75" amp; vbCrLf amp; _
            "CHF" amp; vbCrLf amp; _
            "S" amp; vbCrLf amp; _
            "Pia-Maria Rutschmann-Schnyder" amp; vbCrLf amp; _
            "Grosse Marktgasse" amp; vbCrLf amp; "28/5" amp; vbCrLf amp; _
            "9400" amp; vbCrLf amp; "Rorschach" amp; vbCrLf amp; _
            "CH" amp; vbCrLf amp; _
            "QRR" amp; vbCrLf amp; "210000000003139471430009017" amp; vbCrLf amp; _
            "Beachten sie unsere Sonderangebotswoche bis 23.02.2017!" amp; vbCrLf amp; _
            "EPD" amp; vbCrLf amp; "//S1/10/10201409/11/181105/40/0:30" amp; vbCrLf amp; _
            "eBill/B/41010560425610173"
    End Sub
 

может кто-нибудь мне помочь?

Я думаю, вам также нужно преобразовать разрывы строк, например:

 Temp = Replace(Temp, vbCrLf, "
")