QR Code in Word 2010

[WorldEnder]

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 !

[gmayor]

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-questions/616117-qr-code-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.

[WorldEnder]

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 )

[gmayor]

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.


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

[WorldEnder]

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

[WorldEnder]

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 ;)

[gmayor]

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.

[WorldEnder]

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?

[gmayor]

You should be able to mark it as solved.