EXCELのVBAだけでQRコード。一部修正して日本語（全角）でも作成可能に。サンプルのエクセルファイルあり。

17563 ワード
QRコード QRcode ExcelVBA ExcelVBA テキストリンク

参考（別投稿）

１ファイルのHTML(+JavaScript)で、QRcodeを生成する
https://qiita.com/santarou6/items/db17788158dba38f3a5c

別ライブラリ

2020.10.29追記（以下、教えていただきました）

QRCodeLibVBA

QRCodeLibVBAは、Excel VBAで書かれたQRコード生成ライブラリです。
JIS X 0510に基づくモデル２コードシンボルを生成します。

yas78/QRCodeLibVBA
https://github.com/yas78/QRCodeLibVBA
https://github.com/yas78/QRCodeLibVBA.git

＜本編＞EXCELのVBAだけでQRコード。

サンプルファイルのダウンロード

サンプルファイルのダウンロード

https://github.com/santarou6/QR_EXCEL/raw/master/QRｺｰﾄﾞ作成ｴｸｾﾙ.xlsb
https://github.com/santarou6/QR_EXCEL/blob/master/QRｺｰﾄﾞ作成ｴｸｾﾙ.xlsb

コードの掲示

EXCELのVBAだけでQRコード作るコードが、MITライセンスで、掲示あった

https://code.google.com/archive/p/barcode-vba-macro-only/downloads
リンク

用途（例）

エクセルを利用した、QRコードの作成は、
　・ネット接続／Google Chart API
　・QRコード作成するDLL
　・Excel2016の「Microsoft Barcode Control」
の利用が考えられるが、環境構築に一定の手間。

素のエクセルでQRコードを作れると、そのエクセルファイルだけを配布し、データ入力して出来たものを紙面で郵送してくれ／FAXしてくれ、という、「ローテク」な経路を介しても、「データ入稿」が可能になる。

日本語（全角）用に一部修正

この「barcody.xls」が、日本語（全角）でうまくいかないようだったので、
一部ソースを変えたらうまくいったので、メモです。

（※海外の方のソースなので、全角文字の、「AscW」でマイナス値が返ってくるところが、想定されてなかったと推量）

sample.xls
     k = AscL(Mid(ptext, i, 1))

の箇所が２箇所あるので、

sample.xls
     k = AscL(Mid(ptext, i, 1))
     If k < 0 Then k = k + 65536

と、変えれば、ＯＫ。

追記：シェイプではなく、セルの色塗り方式に変更

2019.3.24追記

原典のbarcody.xls版では、QRコードを「Shapeオブジェクト」を用いて作成しているために、（やや）遅い。

別シートに目の方眼紙（縦横正方形の、細かいセルのもの）用意し、
マス目を塗りつぶすようにすれば、速く作成できる。
（条件付き書式で「1」を黒でセルを塗りつぶす形にする。）

（全般「xShape As Shape」を削除していくのが丁寧ですが、
サブルーチン「Sub bc_2Dms」の中だけ、以下のCase文の修正すれば基本OKだと思います。）

sample.xls
Select Case w
Case 1:     Call drw(x, y, m, m)
Case 2:     Call drw(x + m, y, m, m)
Case 3:     Call drw(x, y, dm, m)
Case 4:     Call drw(x, y + m, m, m)
Case 5:     Call drw(x, y, m, dm)
Case 6:     Call drw(x + m, y, m, m)
            Call drw(x, y + m, m, m)
Case 7:     Call drw(x, y, dm, m)
            Call drw(x, y + m, m, m)
Case 8:     Call drw(x + m, y + m, m, m)
Case 9:     Call drw(x, y, m, m)
            Call drw(x + m, y + m, m, m)
Case 10:    Call drw(x + m, y, m, dm)
Case 11:    Call drw(x, y, dm, m)
            Call drw(x + m, y + m, m, m)
Case 12:    Call drw(x, y + m, dm, m)
Case 13:    Call drw(x, y, m, m)
            Call drw(x, y + m, dm, m)
Case 14:    Call drw(x + m, y, m, m)
            Call drw(x, y + m, dm, m)
Case 15:    Call drw(x, y, dm, dm)
End Select
sample.xls

Sub drw(a, b, c, d)
    Dim xc As Integer
    Dim yr As Integer
    Dim w As Integer
    Dim h As Integer
    xc = CInt((a / 2.5) + 1)
    yr = CInt((b / 2.5) + 1)
    w = CInt((c / 2.5) + 0)
    h = CInt((d / 2.5) + 0)
    Sheets("QR").Cells(yr, xc).Value = 1
    'w
    If w > 1 Then
        Sheets("QR").Cells(yr, xc + 1).Value = 1
    End If
    'h
    If h > 1 Then
        Sheets("QR").Cells(yr + 1, xc).Value = 1
    End If

    If w > 1 And h > 1 Then
        Sheets("QR").Cells(yr + 1, xc + 1).Value = 1
    End If
End Sub

追記：半角数字のみの文字列のエンコードは出来ない模様

2020.2.15追記
詳細は、コメントご参照

（参考：別投稿）エクセルの、ワークシート関数のみでQRコードを作成する