在庫管理表の商品コードや、名刺のURLなどをQRコード化して印刷したい場面は少なくありません。専用ソフトを使わなくても、VBAから無料のQRコード生成APIを呼び出せば、セルの値をもとにQRコード画像を自動作成し、シート上に貼り付けることができます。
この記事では、QRコード生成APIの呼び出しから、画像のダウンロード、シートへの貼り付けまでを一つのマクロで行う方法を解説します。
この記事で作るもの
A列に入力した文字列(URLや商品コードなど)をもとにQRコード画像を生成し、隣のセルに貼り付けるマクロを作成します。QRコード画像自体はインターネット上の無料APIで生成するため、画像編集ソフトなどは一切不要です。
使用するAPIについて
今回はapi.qrserver.comが提供している無料のQRコード生成API(goQR.me)を利用します。URLのパラメータに文字列を渡すだけでQRコード画像(PNG形式)が返ってくる、シンプルな仕組みです。
https://api.qrserver.com/v1/create-qr-code/?size=200x200&data=変換したい文字列
sizeパラメータで画像サイズを、dataパラメータでQRコード化したい文字列を指定します。日本語や記号を含む文字列を渡す場合は、URLエンコードしておく必要があります。
文字列をURLエンコードする
Excel 2013以降であれば、ワークシート関数のEncodeURLをVBAから呼び出せます。日本語や記号を安全にURLへ埋め込めるように変換してくれます。
Dim encodedText As String
encodedText = Application.WorksheetFunction.EncodeURL("https://example.com/商品A")
画像をダウンロードしてファイルに保存する
WinHTTPでAPIから画像データ(バイナリ)を取得し、ADODB.Streamを使ってPNGファイルとして保存します。
Sub DownloadImage(ByVal url As String, ByVal savePath As String)
Dim http As Object
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
http.Open "GET", url, False
http.send
If http.Status = 200 Then
Dim stream As Object
Set stream = CreateObject("ADODB.Stream")
stream.Type = 1 ' adTypeBinary
stream.Open
stream.Write http.responseBody
stream.SaveToFile savePath, 2 ' adSaveCreateOverWrite
stream.Close
Else
MsgBox "QRコードの取得に失敗しました。ステータス: " & http.Status
End If
End Sub
http.responseBodyは画像などのバイナリデータを扱うためのプロパティです。テキストを扱うresponseTextとは違い、画像ファイルの保存にはこちらを使います。
実践:セルの値からQRコードを生成して貼り付ける
ダウンロードした画像をセルの隣に貼り付け、貼り付け後に一時ファイルを削除するところまでを1つのマクロにまとめます。
Sub CreateQRCodeFromCell()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim targetCell As Range
Set targetCell = ws.Range("A1")
If targetCell.Value = "" Then
MsgBox "A1セルにQRコードにしたい文字列を入力してください"
Exit Sub
End If
Dim encodedText As String
encodedText = Application.WorksheetFunction.EncodeURL(CStr(targetCell.Value))
Dim qrUrl As String
qrUrl = "https://api.qrserver.com/v1/create-qr-code/?size=200x200&data=" & encodedText
Dim savePath As String
savePath = Environ("TEMP") & "\qrcode_temp.png"
Call DownloadImage(qrUrl, savePath)
Dim pic As Shape
Set pic = ws.Shapes.AddPicture( _
Filename:=savePath, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=targetCell.Offset(0, 1).Left, _
Top:=targetCell.Offset(0, 1).Top, _
Width:=100, _
Height:=100)
Kill savePath
MsgBox "QRコードを貼り付けました"
End Sub
Shapes.AddPictureのSaveWithDocument:=msoTrueにより、貼り付けた画像はブックに埋め込まれます。元の一時ファイルはブックに保存する必要がないため、貼り付け後にKillで削除しています。
応用:複数行のデータをまとめてQRコード化する
商品一覧など複数行のデータをまとめて処理したい場合は、ループで1行ずつ処理します。行の高さに合わせて画像サイズを調整すると、見た目も整います。
Sub CreateQRCodesForList()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim i As Long
For i = 2 To lastRow ' 1行目は見出し行として除外
Dim targetCell As Range
Set targetCell = ws.Cells(i, "A")
If targetCell.Value <> "" Then
Dim encodedText As String
encodedText = Application.WorksheetFunction.EncodeURL(CStr(targetCell.Value))
Dim qrUrl As String
qrUrl = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data=" & encodedText
Dim savePath As String
savePath = Environ("TEMP") & "\qrcode_" & i & ".png"
Call DownloadImage(qrUrl, savePath)
ws.Shapes.AddPicture _
Filename:=savePath, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=ws.Cells(i, "B").Left, _
Top:=ws.Cells(i, "B").Top, _
Width:=60, _
Height:=60
Kill savePath
End If
Next i
MsgBox "全" & (lastRow - 1) & "件のQRコードを作成しました"
End Sub
注意点
- 外部のWeb APIを利用するため、実行にはインターネット接続が必要です
- 無料APIのため、大量のリクエストを短時間に送るとアクセス制限がかかる場合があります。大量データを処理する場合は
Application.Waitなどで一定間隔を空けることを検討してください - 会社の機密情報や個人情報をQRコード化して外部APIに送信することになるため、扱うデータの内容には注意してください
まとめ
VBAからQRコード生成APIを呼び出し、ADODB.Streamで画像を保存してShapes.AddPictureでシートに貼り付ければ、セルの値から自動でQRコードを作成できます。1件ずつの生成はもちろん、ループ処理と組み合わせれば、商品一覧などの大量データにも対応できます。
在庫管理表や配布資料へのURL埋め込みなど、QRコードが必要な場面でぜひ活用してみてください。


コメント