LoginSignup
18
33

More than 3 years have passed since last update.

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

Last updated at Posted at 2019-03-17

参考(別投稿)

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


別ライブラリ

2020.10.29追記(以下、教えていただきました)

QRCodeLibVBA

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

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
リンク

スクリーンショット 2019-03-17 15.35.00.png

用途(例)

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

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

日本語(全角)用に一部修正

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

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

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

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

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

と、変えれば、OK。

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

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コードを作成する


18
33
14

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
18
33