QR Code in Word 2010

First of all, Hello World !

The Scenario:
- we need to ship mail to people
- 50 operators with Word 2010 that after they complete the word file with the content, they need to type the address of the person the mail has to arrive to ( in the same file )
- they write the address ( in a table cell or something EASY for them `cause of noobs ) and a magical button should be there to convert the address into a QR code - The address must be multi-lined
- the documents arrive at the person responsible with the shipping ( on paper ), he scans the QR Code and prints the sticky label ( on the label will be the human readable address ) that will be put on the package cover

The Assets:
- we will buy the hardware required
- macro enabled files ( checked )
- it doesn`t matter if the QR code is generated with google link as long as it magically appears in their word file
- I write code in other languages but NEVER in VBA ( to be honest I`m a Word noob ) :banghead:

The PROBLEM:
- the solutions for the QR code generator will imply buying 50 licenses ( for which we just do not have the funds, considering the hardware will not be cheap either )
- I have tried countless generators found online, that work great but are outside of the Word file, so, outside the scope and need a bit of PC operating skill to work with ( that unfortunatelly we do not have... ) AND some addins for MSWord but keep crashing the instance OR are getting expensive also
- The designated person to save them is.... me... and I have 4 hours in total of VBA programming, 2 hours yesterday and 2 today... ( I just found out how to make a button OnClick... ), it`s just hell for me, but I learn fast

The Solution:
- ANY help is more than welcomed
- I will add it here for future references

Thank you in advance !

QR Codes are not something with which hitherto I have had any involvement, but a quick search produced some example code for Excel at http://www.mrexcel.com/forum/excel-q...generator.html which you may be able to adapt - even if you have to create the code in Excel and paste it to your document.

cool, I`ll post the solution for word here IF ( and that is a big IF ) I can manage to implement it as needed :) Thanks ! ( I found every other link but not that one it seems )

I had a quick play around with the code from that link, and the following seems to work in Word to put a QR code at the location configured as oRng. Whether the QR code is valid, I have no means of establishing, but it should point you in the right direction. The link at the top of the code gives the parameters.

Code:

---

Option Explicit
'other technical specifications about google chart API:
'https://developers.google.com/chart/infographics/docs/qr_codes

Sub Macro1()
URL_QRCode_SERIES "ABC123", Selection.Range
End Sub

Function URL_QRCode_SERIES( _
        ByVal QR_Value As String, _
        oRng As Range, _
        Optional ByVal PictureSize As Long = 150, _
        Optional ByVal Updateable As Boolean = True) As Variant

Dim oPic As InlineShape
Dim vLeft As Variant, vTop As Variant
Dim sURL As String

Const sRootURL As String = "https://chart.googleapis.com/chart?"
Const sSizeParameter As String = "chs="
Const sTypeChart As String = "cht=qr"
Const sDataParameter As String = "chl="
Const sJoinCHR As String = "&"

    If Updateable = False Then
        URL_QRCode_SERIES = "outdated"
        GoTo lbl_Exit
    End If

    If Len(QR_Value) = 0 Then
        GoTo lbl_Exit
    End If

    sURL = sRootURL & _
          sSizeParameter & PictureSize & "x" & PictureSize & sJoinCHR & _
          sTypeChart & sJoinCHR & _
          sDataParameter & UTF8_URL_Encode(VBA.Replace(QR_Value, " ", "+"))

    Set oPic = ActiveDocument.InlineShapes.AddPicture(sURL, False, True, oRng)
lbl_Exit:
    Exit Function
End Function

Function UTF8_URL_Encode(ByVal sStr As String)
'http://www.nonhostile.com/howto-convert-byte-array-utf8-string-vb6.asp (link no longer valid)
Dim i As Long
Dim a As Long
Dim res As String
Dim code As String

    res = ""
    For i = 1 To Len(sStr)
        a = AscW(Mid(sStr, i, 1))
        If a < 128 Then
            code = Mid(sStr, i, 1)
        ElseIf ((a > 127) And (a < 2048)) Then
            code = URLEncodeByte(((a \ 64) Or 192))
            code = code & URLEncodeByte(((a And 63) Or 128))
        Else
            code = URLEncodeByte(((a \ 144) Or 234))
            code = code & URLEncodeByte((((a \ 64) And 63) Or 128))
            code = code & URLEncodeByte(((a And 63) Or 128))
        End If
        res = res & code
    Next i
    UTF8_URL_Encode = res
lbl_Exit:
Exit Function
End Function

Private Function URLEncodeByte(val As Integer) As String
Dim res As String
    res = "%" & Right("0" & Hex(val), 2)
    URLEncodeByte = res
lbl_Exit:
    Exit Function
End Function

---

Hello again !
Below will post the temporary/almost finished solution. It is not polished because I do not have yet the desired template for the production file, BUT :) here it is!
The word file has at this moment only a table with one row, and 3 cells:
- first cell a picture ContentControl as placeholder for the QR Code about to be generated -
- second cell, button to generate QR
- third cell, a bookmark ( cell bookmark ) that contains whatever anyone wants to type in ( will have paragraphs - multiple lines, in my case )

The script generates QR code with multiple lines



Option Explicit
'other technical specifications about google chart API:

Dim BmAdresa As Range
Dim QR_Value As String
Dim cc As ContentControl




Private Sub BtnQR_Click()
Set BmAdresa = ActiveDocument.Bookmarks("BmAdresa").Range


Set cc = ActiveDocument.ContentControls(1)
If cc.Type = wdContentControlPicture Then
If cc.Range.InlineShapes.Count > 0 Then
cc.Range.InlineShapes(1).Delete
End If

End If
' Had to find and replace the paragraphs with proper "end of line" - ^l
BmAdresa.Find.ClearFormatting
BmAdresa.Find.Replacement.ClearFormatting
With BmAdresa.Find
.Text = "^p"
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
BmAdresa.Find.Execute Replace:=wdReplaceAll
With BmAdresa.Find
.Text = "^p"
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
BmAdresa.Find.Execute Replace:=wdReplaceAll

URL_QRCode_SERIES BmAdresa.Text, cc.Range
End Sub






Function URL_QRCode_SERIES( _
ByRef QR_Value As String, _
oRng As Range, _
Optional ByVal PictureSize As Long = 150, _
Optional ByVal Updateable As Boolean = True) As Variant

Dim oPic As InlineShape
Dim vLeft As Variant, vTop As Variant
Dim sURL As String



Const sRootURL As String = "https://chart.googleapis.com/chart?"
Const sSizeParameter As String = "chs="
Const sTypeChart As String = "cht=qr"
Const sDataParameter As String = "chl="
Const sJoinCHR As String = "&"

If Updateable = False Then
URL_QRCode_SERIES = "outdated"
GoTo lbl_Exit
End If

If Len(QR_Value) = 0 Then
GoTo lbl_Exit
End If
sURL = sRootURL & _
sSizeParameter & PictureSize & "x" & PictureSize & sJoinCHR & _
sTypeChart & sJoinCHR & _
sDataParameter & UTF8_URL_Encode(VBA.Replace(QR_Value, "", "%0A"))
' Above, our "about to encode text" `s value with multiple rows is "prettyfied" for URL - ye ye, too much coffee :)
' Atleast my browser encoding does not display the sign for "soft enter" or how is it called

Set oPic = ActiveDocument.InlineShapes.AddPicture(sURL, False, True, oRng)
lbl_Exit:
Exit Function
End Function



Function UTF8_URL_Encode(ByVal sStr As String)

Dim i As Long
Dim a As Long
Dim res As String
Dim code As String

res = ""
For i = 1 To Len(sStr)
a = AscW(Mid(sStr, i, 1))
If a < 128 Then
code = Mid(sStr, i, 1)
ElseIf ((a > 127) And (a < 2048)) Then
code = URLEncodeByte(((a \ 64) Or 192))
code = code & URLEncodeByte(((a And 63) Or 128))
Else
code = URLEncodeByte(((a \ 144) Or 234))
code = code & URLEncodeByte((((a \ 64) And 63) Or 128))
code = code & URLEncodeByte(((a And 63) Or 128))
End If
res = res & code
Next i
UTF8_URL_Encode = res
lbl_Exit:
Exit Function
End Function


Private Function URLEncodeByte(val As Integer) As String
Dim res As String
res = "%" & Right("0" & Hex(val), 2)
URLEncodeByte = res
lbl_Exit:
Exit Function
End Function

sDataParameter & UTF8_URL_Encode(VBA.Replace(QR_Value, "", "%0A")) well, it`s almost like the MALE sign :) gmayor, you rock, dude next time you visit Bucharest, will rain with beer for you ;)

While my daughter frequently visits Bucharest on business, I am afraid I will have to miss out :( Glad you were able to get it working.

maybe the next time she visits, she`ll take back a special beverage from me that is made in the region I was born in, a bit strong, but damn good :) It`s called "Tuica".
do I have to lock the thread or mark it as "solved" or smth?

You should be able to mark it as solved.