エクセルにバーコードやＱＲコードを画像で挿入する方法

エクセルにて下記のバーコードを生成し画像として挿入する方法をご紹介します。
JAN/CODE-39/NW-7/ITF/UPC/CTF/IATA/MATRIX/NEC/CODE128/CODE93/QR2

※ちなみに私が今回の記事を書くにあたり、ちゃんと読み取れるか試したのはJANコードとQRコードだけです。
それ以外のバーコードに関してはテストを行っていませんので、あらかじめご承知おきください。

画像で挿入することのメリットは、エクセルさえインストールされていれば、どのパソコンでも表示できるということです。
ActiveXコントロールやフォントで作成すると、アクセスやそのフォントが入っていないパソコンでは表示できません。

以前ＪＡＮコードをエクセルのみで画像で挿入する方法を紹介したことがあるのですが、その他のバーコードも作成できるよう、MiBarcodeというフリーソフトを使った画像での生成方法をご紹介しておきます。

なお当方の環境は Windows 7 Professional 、Microsft office 2010 です。
環境が違う場合、MiBarcodeのインストール先などが違ったり、プログラムが動かない可能性もありますので、あらかじめご了承ください。

①まずMiBarcodeをダウンロードしてインストールします。

下記リンクからMibARCODEをダウンロードします。
vectorからダウンロード

vectorのページの緑のリンク画像（ダウンロードはこちら　→　ダウンロードページへ　→　このソフトを今すぐダウンロード）をクリックしていくと「mibarcd62.exe」の保存先を選択するダイアログが出るので、「mibarcd62.exe」をデスクトップに保存します。
保存した「mibarcd62.exe」をダブルクリックして、インストール先フォルダなどは特に設定を変更することなく、それぞれ「次へ」をクリックしてください。

最後に下記画像のように出ると思います。
もし出なかったという場合は後で１行程手順が増えますので憶えておいてください

これでインストールが終了です。

②MiBarcode　の準備

まず始めに、MiBarcodeをインストールした際、①の最後の画像のように出なかった場合を説明します。
下記フォルダの「AutoInst.bat」をダブルクリックしてください。
C:\Program Files\Mibarcode

これで画像のように出ると思います。

Mibarcodeの設定をします。
なお、下の３工程ですが、インストールした時にデフォルトで設定されているかもしれません。

C:\Program Files\Mibarcode　の　「Mibarcd.exe」を開いてください。

編集→コピーの種類→拡張メタファイル(EMF)
を選択します

編集→自動コピー
をチェックします

表示→クリップボード監視
をチェックします

③エクセルの準備
エクセルファイルの列構成はあらかじめ調整しておいてください（先頭から最後まで同じ列なら問題ありません）
また、縦に複数列有る場合でも、元データとバーコードを挿入する列の列数の関係が同じなら問題ありません

「Alt」＋「F11」を押します。
下記のような画面が出ると思いますので、「ツール」をクリック、「参照設定」をクリックしてください。

「MiBarcd Library」にチェックを入れ、「OK」をクリックしてください。

目的のファイル名の上で右クリック
↓
「挿入」をクリック
↓
「標準モジュール」をクリック

すると右側に大きな白いスペースが現れたと思います
※↓画像の赤枠部分

このスペースに以下のコードをコピペしてください
（右下の「1クリックでコードをコピー」をクリックしてください）

Sub MiBcdInsert()

    Dim MiBar As Mibarcd.Auto
    Dim Code As String
    Dim Work As String
    Dim i As Integer
    Dim a As Integer
    Dim s As Integer
    Dim MyVer, MyAns
    
    MyVer = Array(16, 32, 52, 76, 104, 130, 150, 186 _
                    , 222, 262, 310, 354, 408, 446, 508 _
                    , 554, 620, 690, 568, 820, 876, 960 _
                    , 1056, 1122, 1228, 1304, 1384, 1464 _
                    , 1556, 1686, 1788, 1894, 2004, 2120 _
                    , 2226, 2352, 2448, 2584, 2724, 2870)
    
    If IMEStatus <> vbIMEModeOff Then
    SendKeys "{kanji}"
    End If
    
    i = InputBox("バーコードタイプを0～12で指定" & vbCrLf & _
                   "0：JAN" & vbCrLf & _
                   "1：UPC" & vbCrLf & _
                   "2：CODE39" & vbCrLf & _
                   "3：NW-7" & vbCrLf & _
                   "4：ITF" & vbCrLf & _
                   "5：CTF" & vbCrLf & _
                   "6：IATA" & vbCrLf & _
                   "7：MATRIX" & vbCrLf & _
                   "8：NEC" & vbCrLf & _
                   "9：CUSTOMER" & vbCrLf & _
                  "10：CODE128" & vbCrLf & _
                  "11：CODE93" & vbCrLf & _
                  "12：QR2(QRコード)")
     
    s = InputBox("何列右にバーコードを貼り付けますか？")
    
    If i = 12 Then
        MyAns = MsgBox("QRコードのバージョンを指定しますか？" & vbCrLf & "「いいえ」を指定した場合、自動で設定します", vbYesNo)
    End If
    
    If MyAns = vbYes Then
            a = InputBox("バージョンを半角1～40で指定してください")
    End If
    
    Set MiBar = New Mibarcd.Auto
    MiBar.Show (1)
    
    For Each c In Selection
    If i = 12 Then
        If MyAns = vbNo Then
            For a = 0 To 39
                If MyVer(a) / LenB(StrConv(c, vbFromUnicode)) > 1 Then
                    a = a + 3
                    Exit For
                End If
            Next a
        End If
    End If
    
    MiBar.CodeType = i
    MiBar.BarScale = 1
    
    If i = 12 Then
    MiBar.QRVersion = a
    MiBar.QRErrLevel = 1
    End If
    

        MiBar.Code = c.Value
        MiBar.Execute
        
        c.Offset(0, s).PasteSpecial
        
    If i = 12 Then
        With Selection
        .ShapeRange.LockAspectRatio = msoTrue 'バーコードの縦横比を固定
        
             If c.Offset(0, s).Width > c.Height Then   'セルの高さか幅の短い方に合わせる
                .Height = c.Height - 4 'セルの高さよりちょっと低くする
             Else
                .Width = c.Offset(0, s).Width - 4 'セルの幅よりちょっと狭くする
             End If
        
        .Left = c.Offset(0, s).Left + (c.Offset(0, s).Width - .Width) / 2 '横位置　セルの中央に配置
        .Top = c.Offset(0, s).Top + (c.Offset(0, s).Height - .Height) / 2 '縦位置　セルの中央に配置
        End With
    
    
    
    Else
        With Selection
        
        .ShapeRange.LockAspectRatio = msoFalse 'バーコードの縦横比を固定しない
                .Height = c.Height - 4 'セルの高さよりちょっと低くする
                .Width = c.Offset(0, s).Width - 4 'セルの幅よりちょっと狭くする
       
        .Left = c.Offset(0, s).Left + (c.Offset(0, s).Width - .Width) / 2 '横位置　セルの中央に配置
        .Top = c.Offset(0, s).Top + (c.Offset(0, s).Height - .Height) / 2 '縦位置　セルの中央に配置
        End With

        
    End If
    Next c
    
    Set MiBar = Nothing

End Sub

バーコードを作りたい元データを選択してください
1列の場合はそのままマウスをドラッグして範囲選択

複数の離れた範囲の場合は 「Ctrl」 を押しながら選択範囲を設定してください

「開発タブ」の「マクロ」を選択
開発タブが表示されて無い場合は開発タブを表示する方法を参考にしてください

「MiBcdInsert」を選択し「実行」をクリックしてください

ここまでの手順をこなすと、下図のようにバーコードが挿入されると思います

今回の記事を書くにあたり、QRコードのバージョンが問題点となりました。
バージョンが小さいと文字列を格納できず、前の行のデータをそのまま引き継いでしまい、結果元データと全く異なるQRコードができてしまうというものです。
一応大きめのバージョンを自動設定することで解決したつもりですが、他にも不具合が出る可能性はあります。
素人の書いた記事であることを前提にしていただき、あくまでも自己責任で使ってください。
もちろん悪意のあるコード等はありませんが、私のブログが原因で生じた損失等は一切責任を持てませんので悪しからずご了承ください。

※2016/11/23追記
Windows10、Excel2016という環境で、バーコード画像がおかしくなってしまうというコメントをいただきました。
具体的には下図のように、作成された画像の左上1/4のスペースにバーコードができてしまう、というものです。

根本的な解決ではありませんが、もし同じことが起きるという場合は下記コードを試してください。
（挿入した画像をトリミングします）

Sub MiBcdInsert()
Dim MiBar As Mibarcd.Auto
Dim Code As String
Dim Work As String
Dim i As Integer
Dim a As Integer
Dim s As Integer
Dim MyVer, MyAns
MyVer = Array(16, 32, 52, 76, 104, 130, 150, 186 _
, 222, 262, 310, 354, 408, 446, 508 _
, 554, 620, 690, 768, 820, 876, 960 _
, 1056, 1122, 1228, 1304, 1384, 1464 _
, 1556, 1686, 1788, 1894, 2004, 2120 _
, 2226, 2352, 2448, 2584, 2724, 2870)
If IMEStatus <> vbIMEModeOff Then
SendKeys "{kanji}"
End If
i = InputBox("バーコードタイプを0～12で指定" & vbCrLf & _
"0：JAN" & vbCrLf & _
"1：UPC" & vbCrLf & _
"2：CODE39" & vbCrLf & _
"3：NW-7" & vbCrLf & _
"4：ITF" & vbCrLf & _
"5：CTF" & vbCrLf & _
"6：IATA" & vbCrLf & _
"7：MATRIX" & vbCrLf & _
"8：NEC" & vbCrLf & _
"9：CUSTOMER" & vbCrLf & _
"10：CODE128" & vbCrLf & _
"11：CODE93" & vbCrLf & _
"12：QR2(QRコード)")
s = InputBox("何列右にバーコードを貼り付けますか？")
If i = 12 Then
MyAns = MsgBox("QRコードのバージョンを指定しますか？" & vbCrLf & "「いいえ」を指定した場合、自動で設定します", vbYesNo)
End If
If MyAns = vbYes Then
a = InputBox("バージョンを半角1～40で指定してください")
End If
Set MiBar = New Mibarcd.Auto
MiBar.Show (1)
For Each c In Selection
If i = 12 Then
If MyAns = vbNo Then
For a = 0 To 39
If MyVer(a) / LenB(StrConv(c, vbFromUnicode)) > 1 Then
a = a + 3
Exit For
End If
Next a
End If
End If
MiBar.CodeType = i
MiBar.BarScale = 1
If i = 12 Then
MiBar.QRVersion = a
MiBar.QRErrLevel = 1
End If
MiBar.Code = c.Value
MiBar.Execute
c.Offset(0, s).PasteSpecial
If i = 12 Then
With Selection
.ShapeRange.LockAspectRatio = msoTrue 'バーコードの縦横比を固定
Set shapeToCrop = ActiveWindow.Selection.ShapeRange(.Name)
With shapeToCrop.Duplicate
.ScaleHeight 1, True
.ScaleWidth 1, True
origHeight = .Height
origWidth = .Width
.Delete
End With
cropPoints_h = origHeight * 0.5
cropPoints_w = origWidth * 0.5
shapeToCrop.PictureFormat.CropBottom = cropPoints_h
shapeToCrop.PictureFormat.CropRight = cropPoints_w
If c.Offset(0, s).Width > c.Height Then 'セルの高さか幅の短い方に合わせる
.Height = c.Height - 4 'セルの高さよりちょっと低くする
Else
.Width = c.Offset(0, s).Width - 4 'セルの幅よりちょっと狭くする
End If
.Left = c.Offset(0, s).Left + (c.Offset(0, s).Width - .Width) / 2 '横位置　セルの中央に配置
.Top = c.Offset(0, s).Top + (c.Offset(0, s).Height - .Height) / 2 '縦位置　セルの中央に配置
End With
Else
With Selection
.ShapeRange.LockAspectRatio = msoFalse 'バーコードの縦横比を固定しない
Set shapeToCrop = ActiveWindow.Selection.ShapeRange(.Name)
With shapeToCrop.Duplicate
.ScaleHeight 1, True
.ScaleWidth 1, True
origHeight = .Height
origWidth = .Width
.Delete
End With
cropPoints_h = origHeight * 0.5
cropPoints_w = origWidth * 0.5
shapeToCrop.PictureFormat.CropBottom = cropPoints_h
shapeToCrop.PictureFormat.CropRight = cropPoints_w
.Height = c.Height - 4 'セルの高さよりちょっと低くする
.Width = c.Offset(0, s).Width - 4 'セルの幅よりちょっと狭くする
.Left = c.Offset(0, s).Left + (c.Offset(0, s).Width - .Width) / 2 '横位置　セルの中央に配置
.Top = c.Offset(0, s).Top + (c.Offset(0, s).Height - .Height) / 2 '縦位置　セルの中央に配置
End With
End If
Next c
Set MiBar = Nothing
End Sub