VBA 203号室:ExcelシートにQRコードを追加

ExcelシートのセルにQRコードを任意に追加します

Kappo

Excelシート上に複数のQRコードを配置する場合．．．．．
　●一つのQRコート（オブジェクト）をコピーする
　●QRコードを張り付けする
　●貼り付けたQRコードの情報を編集する
　　（プロパティを開いて直接入力／リンク先指定）
ってなり、結構手間かかりませんか？！
そんな時はこの部屋の方法を使うと簡単に複数のQRコードを任意の場所に配置が可能でとっても便利ですよ！！
また、一番したの方にコメント欄があるからよかったら質問・感想などメッセージ入れてください

■メリット
　・メニュー＝開発->挿入->バーコードコントロールで作成しなくても出来る
　・コントロールのプロパティで値位置を指定しなくてもいい
■デメリット
　・プログラムを動かしてみないとQRの大きさが判らない

VBA－参照ライブラリを追加する（参照設定）
ExcelシートのセルにQRコードに追加するプログラム
呼びだすプログラム（例）
プログラムの実行

VBA－参照ライブラリを追加する（参照設定）

VBAプログラムで「バーコード」が使えるようにライブラリを参照設定で追加する

■Excel■
　メニュー->開発->ｺｰﾄﾞの表示
　　↓
■VBAプログラムView■
　メニュー->ﾂｰﾙ->参照設定

☆追加するライブラリ＝Microsoft Access BarCode Contorol ###
（###はバージョンによって異なります）

■参照設定－VBAProjectダイアログ■
Microsoft Access BarCode Contorol ###にレ点－＞「OK」ボタン

ExcelシートのセルにQRコードに追加するプログラム

●●サブルーチンプログラム●●
標準モジュール（QrCtrl）にブログラムを記述
※標準モジュールの追加は「Excelシート内で指定した描画オブジェクトの名前を取得するプログラム」を参照してください

サブルーチンの内容
QrCreate(ByVal shtName As String, qrNo As Integer, qrPos As String, qrData As String)
引数：shtName=QRを配置したいシート名、qrNo=QRコード名+番号、
qrPos=QRを配置するセル番号（Rangeに渡す文字列）、
qrData=QR表示するデータ
戻り：True

※OLEオブジェクト名前用の番号：”QRコード”+番号=名前を付けておくと作成後の処理がしやすくなる

▼プログラム▼

Public Function QrCreate(ByVal shtName As String, qrNo As Integer, qrPos As String, qrData As String)

    Dim Ret As Boolean

    Ret = True

    '----------------------------------------

    Dim wsht As Worksheet
    Dim qrObj As OLEObject 'OLEオブジェクトの宣言
    Dim topPosition As Double 'シート内の上角位置
    Dim leftPosition As Double 'シート内の左角位置

    Set wsht = Thisworkbook.Worksheets(shtName)

    '----------------------------------------
    'シートにBacodeCtrlを追加するオブジェクトを作成
    Set qrObj=wsht.OLEObject.Add("BARCODE.BarCodeCtrl.1")

    '----------------------------------------
    'OLEObjectをQRコードにする
    qrObj.Object.Style = 11 'QRコード(=11)を指定

    '----------------------------------------
    'QRコードのデータを指定
    qrObj.Object.Value = qrData

    '----------------------------------------
    'QRを作りたいセルの左上の位置を指定する（表示させる位置を取得）
    With Thisworkbook.Worksheets(shName).Range(qrPos)
        topPosition = .Top
        leftPosition = .Left
    End With

    '----------------------------------------
    'QRコードのサイズ、位置、名前を指定して作成
    With qrObj
        '縦と横のサイズ＝今回は50×50のQRコードを指定（例）
        .Height = 50
        .Width = 50

        '作成する位置を指定：上述のセル角位置からオフセット=+5を指定（例）
        .Top = topPosition + 5
        .Left = leftPosition + 5

        'オブジェクトの名前を指定
        .Name = "QRコード" & qrNo
    End With

    '----------------------------------------
    'オブジェクトの解放(後片付け)
    Set qrObj = Nothing

    '----------------------------------------

    QrCreate = Ret

    '----------------------------------------

End Function

呼びだすプログラム（例）

サブルーチンプログラムが出来たので呼びだすコマンドボタンを配置してプログラムを記述する

コマンドボタンがクリックされた時に実行されるプログラム
「CommandButton4」
※ボタンの配置方法は「VBA：描画オブジェクトの名前取得」を参照してください

コマンドボタンがクリックされた時に実行されるプログラム

Sheet1のセル＝D13の値をセル＝E13にQRを挿入する

▼プログラム▼

Private Sub CommandButton4_Click()

    Dim ret As Boolean    '戻り値用
    Dim shtData As String    'QRのデータ用

    shtData = Worksheets("Sheet1").Cells(13, 4)    'セル=D13の値

    ret = QrCreate("Sheet1", 1, "E13", shtData)

End Sub