VBAでQRコード連続生成と最小化(約5×5㎜)

こんにちは、Ryoです。
前回VBAでバーコード生成をご紹介しましたので、今回はExcel-VBAでQRコードを
連続生成する方法について書いてみたいと思います。
最近は客先へ納品する製品にもバーコードやQRコードのラベル貼付けを求められることが
多いので、その際に作った内容をご紹介します。

QRコード化する為にはGoogleが提供している「Google Chart API」を使います。
これは色々なグラフを生成してくれるAPIで、その中に「QRコード化」もあります。
参考にさせていただいた記事はこちら!
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コードリーダーでも読み取れていますので大丈夫だろうと思います。

<< 5mmサイズのQRコードを読み取れるリーダー

[MEOW MARKET] QRコード読み込みバーコード
リーダー レーザー式 USB接続 バーコードスキャナー
1次元コード 2次元コード 液晶読み込み
小型 軽量 手持ち型 設定不要 PDF日本語説明書

QRコードの良さは省スペース、日本語最大で1,817文字まで、英数字のみで最大4,296文字
まで含められるということだと思います。
機会があればぜひご活用くださいませ。

Ryo

スポンサーリンク
スポンサーリンク

楽天トラベル

シェアする

フォローする

スポンサーリンク

楽天トラベル