こんにちは、Ryoです。
前回VBAでバーコード生成をご紹介しましたので、今回はExcel-VBAでQRコードを
連続生成する方法について書いてみたいと思います。
最近は客先へ納品する製品にもバーコードやQRコードのラベル貼付けを求められることが
多いので、その際に作った内容をご紹介します。
QRコード化する為にはGoogleが提供している「Google Chart API」を使います。
これは色々なグラフを生成してくれるAPIで、その中に「QRコード化」もあります。
参考にさせていただいた記事はこちら！
右のQRコードはリンク先の記事を参考にweb上で表示しています。
携帯端末でも読めますので、良かったらぜひ。
私のブログサイトURL等が表示されると思います。
今回はこの機能を使って、Excel-VBAで連続生成してセル上に貼付ける一連の流れと、私の場合は貼り付けるラベルが非常に小さいので最小でどこまで出来るか試して約5×5㎜まで大丈夫なのを確認できていますので、
その辺りも併せてご紹介します。
1.概要
今回のサンプルはこのような幅の狭いラベルがあるとして、SN（シリアルナンバー）を
QRコード化し貼り付けるコードになります。
処理にやや時間を要するので、併せてプログレスバーも表示し進行度合いを明確に
しています。
処理を実行するとInputBoxにて開始SNの入力を促し、それを反映させてからQRコード化し
Google Chart APIから取得した画像サイズを調整して貼り付けます。
QRコードのサイズとしては約5×5mm程度ですが、携帯端末でも読み込めます。
ちなみにSNは開始番号をInputBoxで受け取り、羅列する処理は数式で実施しています。
2.使用環境
- OS：Windows7,Windows10は動作確認済みです。
- Excel ：Office2010で作成しています。
- Office2010以降の動作確認はしていませんが、多分動くんじゃないかと思います。
- Excel Sheet：QRコードを出力させたい1Sheetで十分です。
3.VBAコード構成
コード構成はさほど複雑ではなく「InputBox」で開始SNを入力し、必要な情報を読み込んで「Google Chart APIに情報を渡し画像を必要数取得」する。
その間、やや時間がかかるので「プログレスバー」で進捗を表示するという構成です。
Sub QR_Out()
Dim i, s, sum, LastRow As Long
Dim progress As Integer
Dim count As Long
count = 30 'QRコード化するMax数量
Cells(2, 6).Select
Dim ans As String ' InputBoxの戻り
Dim flg As Boolean ' 数値判定用のフラグ
flg = False
Do
ans = InputBox("開始するS/Nを入力してください。")
If StrPtr(ans) = 0 Then Exit Sub 'StrPtr関数でキャンセル判定
If IsNumeric(ans) Then flg = True 'IsNumeric関数で数値判定
Loop Until flg = True '数値が入力されるまで繰り返す
ActiveCell = ans
UserForm1.Show vbModeless 'プログレスバーを表示
UserForm1.ProgressBar1.Min = 1 'Min値設定
UserForm1.ProgressBar1.Max = count 'QRコード化するMax値
UserForm1.ProgressBar1.Value = 1 '1からスタートさせる
Application.Cursor = xlWait 'マウスカーソルのウェイト化（お好みで）
Application.ScreenUpdating = False '画面固定化
'入力されている最終行の検索
LastRow = Cells(Rows.count, 1).End(xlUp).Row
For i = 1 To 3 '3回繰り返し
For s = 2 To LastRow '最終行まで繰り返し
sum = sum + 1
Select Case i '3列それぞれの開始位置
Case 1
Cells(s, 5).Select
Case 2
Cells(s, 12).Select
Case 3
Cells(s, 19).Select
End Select
If ActiveCell.Offset(0, 1) = "" Then
ActiveCell.Offset(1, 0).Select
s = s + 1
End If
'アクティブセルの現在位置取得
Adr = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
'Google Chart APIへ送る情報の一部
URL = "https://chart.googleapis.com/chart?cht=qr&chs=30x30&chco=000000&chl="
'注記）サイズ指定（chs=）は30×30が最小
Select Case i 'Google Chart API情報にSN情報を結合
Case 1
URL = URL & "" & Cells(s, 6).Value & ""
Case 2
URL = URL & "" & Cells(s, 13).Value & ""
Case 3
URL = URL & "" & Cells(s, 20).Value & ""
End Select
'受け取った画像のサイズを調整して貼付け
If Not URL = "" Then
ActiveSheet.Pictures.Insert(URL).Select
Selection.Height = Selection.Height * 0.72
Selection.Width = Selection.Width * 0.72
End If
'先程取得したセルアドレスに対し貼付け位置調整
With Selection
.Top = Range(Adr).Top + 1.05
.Left = Range(Adr).Left + 2.5
End With
'表示しているプログレスバーのキャンセルボタンが押された場合の処理
If UserForm1.IsCancel = True Then
Unload UserForm1
Application.Cursor = xlDefault
Call Clr '処理済み画像の全クリア処理
MsgBox "処理を中断しました。"
End
End If
'プログレスバーの値表示を更新
If UserForm1.ProgressBar1.Min < sum And UserForm1.ProgressBar1.Max >= sum Then
'プログレスバーのLabel表示を更新
progress = CInt(sum / count * 100)
UserForm1.Label2.Caption = progress & "%完了"
'プログレスバーの値を更新
UserForm1.ProgressBar1.Value = sum
'滞留処理を実行
DoEvents
End If
Next s
Next i
Unload UserForm1
Application.Cursor = xlDefault
Cells(1,1).Select
Application.ScreenUpdating = True
MsgBox "QRコード生成完了しました！"
End Sub
処理中断時や手動で画像クリア用のコードは以下の通りです。
Sub Clr() Dim MyOb As Object For Each MyOb In ActiveSheet.Pictures MyOb.Delete Next End Sub
4.コード解説
Do
ans = InputBox("開始するS/Nを入力してください。")
If StrPtr(ans) = 0 Then Exit Sub 'StrPtr関数でキャンセル判定
If IsNumeric(ans) Then flg = True 'IsNumeric関数で数値判定
Loop Until flg = True '数値が入力されるまで繰り返す
ActiveCell = ans
この部分でInputBoxを表示しSN入力を促しますが、その際のキャンセル処理を
StrPtr関数、数値入力判定をIsNumeric関数で行っています。
そして数値以外が入力されれば、延々とInputボックスが表示され続けるように
Do～Loop Until 条件で繰り返し処理を行います。
UserForm1.Show vbModeless 'プログレスバーを表示 UserForm1.ProgressBar1.Min = 1 'Min値設定 UserForm1.ProgressBar1.Max = count 'QRコード化するMax値 UserForm1.ProgressBar1.Value = 1 '1からスタートさせる Application.Cursor = xlWait 'マウスカーソルのウェイト化（お好みで） Application.ScreenUpdating = False '画面固定化 '入力されている最終行の検索 LastRow = Cells(Rows.count, 1).End(xlUp).Row
進捗を表示するプログレスバーの設定を行います。
Min値は1、Max値は本サンプルの場合は最大30です。
マウスカーソルのxlWaitは丸上のくるくる回るお馴染みの状態を指定していますが、
ここは特に記述しなくても特に問題ありません。
LastRowはセルA列に対し、入力されている最終行を判定するものです。
プログレスバーのフォームとプロパティは次の通りです。
フォームはお好みのデザインで良いと思います。
プロパティも必要となるパラメータはコードで指定しますので参考程度ですが、
「オブジェクト名」はコードの記述と整合させる必要があります。
For i = 1 To 3 '3回繰り返し
For s = 2 To LastRow '最終行まで繰り返し
sum = sum + 1
Select Case i '3列それぞれの開始位置
Case 1
Cells(s, 5).Select
Case 2
Cells(s, 12).Select
Case 3
Cells(s, 19).Select
End Select
If ActiveCell.Offset(0, 1) = "" Then
ActiveCell.Offset(1, 0).Select
s = s + 1
End If
今回のサンプルでは3列の10行分QRコード生成しますのでiは列分、
sは行分の繰り返し処理を指定します。
その後Select Caseにてiの数値より各列の開始位置を選択しています。
If文は仮にSNが入力されておらず空白だった場合は次の行に移行し、
その分をsに加算する処理になります。
'アクティブセルの現在位置取得
Adr = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
'Google Chart APIへ送る情報の一部
URL = "https://chart.googleapis.com/chart?cht=qr&chs=30x30&chco=000000&chl="
'注記）サイズ指定（chs=）は30×30が最小
Select Case i 'Google Chart API情報にSN情報を結合
Case 1
URL = URL & "" & Cells(s, 6).Value & ""
Case 2
URL = URL & "" & Cells(s, 13).Value & ""
Case 3
URL = URL & "" & Cells(s, 20).Value & ""
End Select
後の処理で貼付け位置を調整する際に必要なセルアドレスを取得しておき、
冒頭でご説明したGoogle Chart APIのアドレスを仮にURLとした変数に格納します。
その後、列をSelect Caseで判定し必要となるSN情報を＆にて結合します。
コード内にも記載していますが、サイズは30×30が最小で、それ以下にすると帰ってくる
画像にQRコードは表示されませんのでご注意ください。
'受け取った画像のサイズを調整して貼付け
If Not URL = "" Then
ActiveSheet.Pictures.Insert(URL).Select
Selection.Height = Selection.Height * 0.72
Selection.Width = Selection.Width * 0.72
End If
'先程取得したセルアドレスに対し貼付け位置調整
With Selection
.Top = Range(Adr).Top + 1.05
.Left = Range(Adr).Left + 2.5
End With
URLに格納されていることをIf Notで確認し、Sheetへ貼付けを行いますが、
その際にHeight,Widthをそれぞれ*0.72とすることで約5×5mmになります。
後は取得した画像の位置をTopとLeftで補正し、適正な位置に移動させます。
'表示しているプログレスバーのキャンセルボタンが押された場合の処理
If UserForm1.IsCancel = True Then
Unload UserForm1
Application.Cursor = xlDefault
Call Clr '処理済み画像の全クリア処理
MsgBox "処理を中断しました。"
End
End If
'プログレスバーの値表示を更新
If UserForm1.ProgressBar1.Min < sum And UserForm1.ProgressBar1.Max >= sum Then
'プログレスバーのLabel表示を更新
progress = CInt(sum / count * 100)
UserForm1.Label2.Caption = progress & "%完了"
'プログレスバーの値を更新
UserForm1.ProgressBar1.Value = sum
'滞留処理を実行
DoEvents
End If
Next s
Next i
ここはプログレスバーの処理になりますが、キャンセルボタンが押されたら
フォームを閉じてマウスカーソルを通常に戻して、途中まで貼り付けられた
画像をCall Clrで全消去し、プログラム処理を終了させます。
継続している場合はプログレスバーの値を更新する処理を行いますので
処理数（QRコード化数）が現在値以上で且つ指定Max値以下の条件の時に、
進捗を計算しCInt関数で数値化し、フォームのラベルに表示させています。
Unload UserForm1
Application.Cursor = xlDefault
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "QRコード生成完了しました！"
End Sub
全て処理が完了したらフォームを閉じ、マウスカーソルを通常に戻して
画面固定化を解除し生成完了をMsgBoxにて出力しています。
ここまでで、QRコード化するメイン処理は完了です。
Sub Clr() Dim MyOb As Object For Each MyOb In ActiveSheet.Pictures MyOb.Delete Next End Sub
これはCallで呼び出している画像クリアのコードになります。
For Eachでシート上のPictureを全て対象としを削除しますので、
単体で「Clear」ボタン等に登録しても使えます。
以上がコード解説になります。
Google Chart APIで取得した画像をさらにサイズ調整していますが、私が確認する限り
携帯端末アプリとQRコードリーダーでも読み取れていますので大丈夫だろうと思います。
QRコードの良さは省スペース、日本語最大で1,817文字まで、英数字のみで最大4,296文字
まで含められるということだと思います。
機会があればぜひご活用くださいませ。
Ryo
