【VBA】QRコード生成（アクセスのバーコードコントロール使用）

こんにちは、Ryoです。
以前Google APIを利用したQRコード生成の記事は書いていますが、今回はアクセスのバーコードコントロールを使用した方法について書いていきます。サンプル概要やサンプルコードは以前投稿しているバーコード生成記事の一部を変更しているだけですから詳細な解説はリンク先をご確認くださいませ！

。。。久々更新な気がしますが、決してサボっていたのではなく決算期で忙しいのもあり中々書けませんでした。。。が、合間見て書いていきますので今後共宜しくお願いします。

1.サンプル概要
2.サンプルコード
- ◆15mm×15mm
- ◆10mm×10mm
3.まとめ

1.サンプル概要

先ず、以前の記事については以下の通りです。
Accessのバーコードコントロールを使用してバーコード生成するものになります。Accessのコントロールを使いますから、Accessインストールとコントロールの参照設定は必須なので、この記事から読んでいる方はお手数ですがリンク先も確認してくださいね。又、リンク先も本記事もExcel2016で作成～動作確認したものです。

【VBA】Excelでバーコードコントロールを使用し生成する

こんにちは、Ryoです。以前にバーコードフォントを使用した生成について記事を書いていますが、今回はリクエストいただいたこともあり、ExcelVBAでバーコードコントロール（Microsoft　Access BarCode Control 1...

そしてサンプル概要ですが、以下の表の通りQRコード化したい一覧があり、その右側にQRコードを生成する内容になります。今回はサンプルとして「15mm×15mm」と「10mm×10mm」サイズの2通りとしています。

可能であればサイズは大きくした方が読取り上も問題ないのですが、今回のサンプルサイズでも読み取れることは確認しています。

2.サンプルコード

◆15mm×15mm

Sub QR15_Sample()
'QRコード15mm×15mmサイズ

  Dim Str_Code As Variant
  Dim Start_Add, Col As String
  Dim Row_Pos, Col_Num, LastRow, Count As Long
  Dim QR_Data() As String
  Dim i As Integer
  
  '**QRコード化するCodeデータ読み込み**
  
  For Each Str_Code In Range("A:A")
       If Str_Code = "Code" Then
            Row_Pos = Str_Code.Row
            Start_Add = Str_Code.Address(True, False)
            Col = Left(Start_Add, InStr(Start_Add, "$") - 1)
            Col_Num = Asc(Col) - 64  '列番号アルファベットを数値化
            LastRow = Cells(Rows.Count, Col_Num).End(xlUp).Row  'データ入力最終行
            Count = LastRow - Row_Pos 'データ数
        End If
   Next

   ReDim QR_Data(1 To Count) As String

   'QRコードへのリンクセル設定用にデータ入力セルのアドレスを取得
   For i = 1 To Count
     QR_Data(i) = Cells(Row_Pos + i, Col_Num).Address(RowAbsolute:=False, ColumnAbsolute:=False)
   Next i
   
   '**QRコード貼付けセルのサイズ指定処理**

    'このサイズ設定はQRコード化する内容により適宜調整
    Rows(Row_Pos + 1 & ":" & LastRow).RowHeight = 80
    Columns(Col_Num + 1).ColumnWidth = 15
    
      
    '**QRコードコントロールプロパティ設定**
    
    'プロパティについては以下URLのMSDN参照
    'https://msdn.microsoft.com/ja-jp/library/cc427149.aspx
    
    Const QR_Style As Integer = 11
    'スタイル
    '0: UPC-A, 1: UPC-E, 2: JAN-13, 3: JAN-8, 4: Casecode, 5: NW-7,
    '6: Code-39, 7: Code-128, 8: U.S. Postnet, 9: U.S. Postal FIM, 10: 郵便物の表示用途（日本）
    '11: QRコード
    
    Const QR_Substyle As Integer = 0
    'サブスタイル (下記URL参照)
    'http://msdn.microsoft.com/ja-jp/library/cc427156.aspx
    
    Const QR_Validation As Integer = 2
    'データの確認
    '0: 確認無し, 1: 無効なら計算を補正, 2: 無効なら非表示
    'Code39/NW-7の場合、「1」でスタート/ストップ文字(*)を自動的に追加
    
    Const QR_LineWeight As Integer = 3
    '線の太さ
    '0: 極細線, 1:細線, 2:中細線, 3:標準, 4:中太線, 5: 太線, 6:極太線, 7:超極太線
    
    Const QR_Direction As Integer = 0
    'QRコードの表示方向
    '0: 0度, 1: 90度, 2: 180度, 3: 270度　[0]が標準
    
    Const QR_ShowData As Integer = 0
    'データの表示
    '0: 表示無し, 1:表示有り
    
    Const QR_ForeColor As Long = rgbBlack
    '前景色の指定
    
    Const QR_BackColor As Long = rgbWhite
    '背景色の指定
    
    'rgbBlackなどの色定数は以下URLのMSDN参照
    'https://msdn.microsoft.com/ja-jp/VBA/Excel-VBA/articles/xlrgbcolor-enumeration-excel
    
   '**QRコード化の処理＊＊
   
    Dim QR_OLE_Obj As OLEObject
    Dim QR_Obj As BARCODELib.BarCodeCtrl
      
    For i = 1 To Count
        'QRコードサイズ、及び貼り付ける位置の指定
        '上で設定したセルサイズに対し、枠内中央とする為にTop/Leftは+5、Height/Widthは-10
        With Cells(i + Row_Pos, Col_Num + 1)
           ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1", Link:=False, DisplayAsIcon:=False, _
            Top:=.Top + 10, Left:=.Left + 10, Height:=.Height - 20, Width:=.Width - 20).Select
        End With
                     
        Set QR_OLE_Obj = Selection
        Set QR_Obj = QR_OLE_Obj.Object
         
        'QRコードにプロパティ設定
        With QR_Obj
          .Style = QR_Style
          .SubStyle = QR_Substyle
          .Validation = QR_Validation
          .LineWeight = QR_LineWeight
          .Direction = QR_Direction
          .ShowData = QR_ShowData
          .ForeColor = QR_ForeColor
          .BackColor = QR_BackColor
          .Refresh
         End With
         
         'リンクするセルアドレスを指定
         With QR_OLE_Obj
           .Visible = False
           .LinkedCell = Range(QR_Data(i)).Address(RowAbsolute:=False, ColumnAbsolute:=False, _
            ReferenceStyle:=Application.ReferenceStyle)
           .Visible = True
         End With
                    
     Next i
   
End Sub

上にも書きましたが、本コードはほぼバーコード生成で紹介した内容と同じです。
違うのはスタイル設定の部分で、

Const QR_Style As Integer = 11

ここを11として設定することでQRコードになります。
サンプルコードをそのまま実行すれば約15×15mmサイズですので、用途に応じて適宜調整してください。

◆10mm×10mm

Sub QR10_Sample()
'QRコード10mm×10mmサイズ

  Dim Str_Code As Variant
  Dim Start_Add, Col As String
  Dim Row_Pos, Col_Num, LastRow, Count As Long
  Dim QR_Data() As String
  Dim i As Integer
  
  '**QRコード化するCodeデータ読み込み**
  
  For Each Str_Code In Range("A:A")
       If Str_Code = "Code" Then
            Row_Pos = Str_Code.Row
            Start_Add = Str_Code.Address(True, False)
            Col = Left(Start_Add, InStr(Start_Add, "$") - 1)
            Col_Num = Asc(Col) - 64  '列番号アルファベットを数値化
            LastRow = Cells(Rows.Count, Col_Num).End(xlUp).Row  'データ入力最終行
            Count = LastRow - Row_Pos 'データ数
        End If
   Next

   ReDim QR_Data(1 To Count) As String

   'QRコードへのリンクセル設定用にデータ入力セルのアドレスを取得
   For i = 1 To Count
     QR_Data(i) = Cells(Row_Pos + i, Col_Num).Address(RowAbsolute:=False, ColumnAbsolute:=False)
   Next i
   
   '**QRコード貼付けセルのサイズ指定処理**

    'このサイズ設定はQRコード化する内容により適宜調整
    Rows(Row_Pos + 1 & ":" & LastRow).RowHeight = 50
    Columns(Col_Num + 1).ColumnWidth = 10
    
      
    '**QRコードコントロールプロパティ設定**
    
    'プロパティについては以下URLのMSDN参照
    'https://msdn.microsoft.com/ja-jp/library/cc427149.aspx
    
    Const QR_Style As Integer = 11
    'スタイル
    '0: UPC-A, 1: UPC-E, 2: JAN-13, 3: JAN-8, 4: Casecode, 5: NW-7,
    '6: Code-39, 7: Code-128, 8: U.S. Postnet, 9: U.S. Postal FIM, 10: 郵便物の表示用途（日本）
    '11: QRコード
    
    Const QR_Substyle As Integer = 0
    'サブスタイル (下記URL参照)
    'http://msdn.microsoft.com/ja-jp/library/cc427156.aspx
    
    Const QR_Validation As Integer = 2
    'データの確認
    '0: 確認無し, 1: 無効なら計算を補正, 2: 無効なら非表示
    'Code39/NW-7の場合、「1」でスタート/ストップ文字(*)を自動的に追加
    
    Const QR_LineWeight As Integer = 3
    '線の太さ
    '0: 極細線, 1:細線, 2:中細線, 3:標準, 4:中太線, 5: 太線, 6:極太線, 7:超極太線
    
    Const QR_Direction As Integer = 0
    'QRコードの表示方向
    '0: 0度, 1: 90度, 2: 180度, 3: 270度　[0]が標準
    
    Const QR_ShowData As Integer = 0
    'データの表示
    '0: 表示無し, 1:表示有り
    
    Const QR_ForeColor As Long = rgbBlack
    '前景色の指定
    
    Const QR_BackColor As Long = rgbWhite
    '背景色の指定
    
    'rgbBlackなどの色定数は以下URLのMSDN参照
    'https://msdn.microsoft.com/ja-jp/VBA/Excel-VBA/articles/xlrgbcolor-enumeration-excel
    
   '**QRコード化の処理＊＊
   
    Dim QR_OLE_Obj As OLEObject
    Dim QR_Obj As BARCODELib.BarCodeCtrl
      
    For i = 1 To Count
        'QRコードサイズ、及び貼り付ける位置の指定
        '上で設定したセルサイズに対し、枠内中央とする為にTop/Leftは+5、Height/Widthは-10
        With Cells(i + Row_Pos, Col_Num + 1)
           ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1", Link:=False, DisplayAsIcon:=False, _
            Top:=.Top + 5, Left:=.Left + 5, Height:=.Height - 10, Width:=.Width - 10).Select
        End With
                     
        Set QR_OLE_Obj = Selection
        Set QR_Obj = QR_OLE_Obj.Object
         
        'QRコードにプロパティ設定
        With QR_Obj
          .Style = QR_Style
          .SubStyle = QR_Substyle
          .Validation = QR_Validation
          .LineWeight = QR_LineWeight
          .Direction = QR_Direction
          .ShowData = QR_ShowData
          .ForeColor = QR_ForeColor
          .BackColor = QR_BackColor
          .Refresh
         End With
         
         'リンクするセルアドレスを指定
         With QR_OLE_Obj
           .Visible = False
           .LinkedCell = Range(QR_Data(i)).Address(RowAbsolute:=False, ColumnAbsolute:=False, _
            ReferenceStyle:=Application.ReferenceStyle)
           .Visible = True
         End With
                    
     Next i
   
End Sub

そしてこちらが約10×10mmサイズになります。
どちらも私が確認する限りでは読取り出来ていますが、画面でみるよりも印刷品質が落ちたりする場合もあるので、サイズ調整などしながら使っていくと良いかもしれませんね。

3.まとめ

サンプル概要とサンプルコードのみという記事になってしまってますが、上で申し上げたリンク先記事で解説してますから、何卒ご容赦くださいませ！

Accessのコントロールを使うことでExcelでもバーコードやQRコードを生成出来る訳ですが、MicrosoftとしてはExcelでの動作は保証して無いような旨も書いて有ったりしますから、使用しているExcelのバージョンによっては上手く動作しなかったり、印刷品質が劣化したりするようなので、本サンプルは一例として参考にしてもらえたら良いかな、と思います。

以上、QRコード生成（Accessのバーコードコントロール使用）についてでした！
今回の記事が何かの参考になれば幸いです。

Ryo