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


#参考（別投稿）
１ファイルの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/blob/master/QR%EF%BD%BA%EF%BD%B0%EF%BE%84%EF%BE%9E%E4%BD%9C%E6%88%90%EF%BD%B4%EF%BD%B8%EF%BD%BE%EF%BE%99.xlsb)

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
[リンク](https://code.google.com/archive/p/barcode-vba-macro-only/downloads)

<img width="427" alt="スクリーンショット 2019-03-17 15.35.00.png" src="https://qiita-image-store.s3.amazonaws.com/0/107418/8770792a-d293-5e5c-f23a-9e3ba61343e5.png">

## 用途（例）

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

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

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

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

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

```vb:sample.xls
     k = AscL(Mid(ptext, i, 1))
```
の箇所が２箇所あるので、

```vb: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だと思います。）

```vb: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
```

```vb: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コードを作成する
https://qiita.com/santarou6/items/dda2f88f42c55cd2118f
- - -