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

URLをコピーする
URLをコピーしました!

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

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

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

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

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

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

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

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

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

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

②MiBarcode の準備

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

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

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

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

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

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

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

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

「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
シェア頂けると嬉しいです!よろしくお願いします!
URLをコピーする
URLをコピーしました!
  • URLをコピーしました!

コメント

コメント一覧 (16件)

  • 配列の・・・
    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)
    この配列にはどういった意味合いがあるのか疑問に持ちました。
    プログラミング言語初級者の者で、勉強不足の面もあるかと思いますが、教えてください。

    • こんにちは
      その配列ですが、QRコードに格納する文字数を判定するための配列です。
      下記URLにある表から、「誤り訂正レベルM」の「漢字」を基準にして設定した配列です。(漢字を基準にLENB関数で判定しているので倍にしています)
      QRコードのバージョン

      つまり「QRコードのバージョンを決めるために私が適当に作った配列」です。

      ご参考になれば幸いです。

  • VBAから利用させていただいております。
    一つ誤記があるようです。
    MyVer のArrayで、690の次は768です。比較的大きいデータでテストしたとき、たまたま文字数オーバーになって調べたらこれが原因だったようです。

    • 指摘いただきありがとうございます。
      早速修正させていただきました。
      思いっきり間違ってましたね・・・
      今後極力ミスが起こらないよう注意してまいります。

  • こんにちは.
    バーコード挿入した時に、写真のように大きくならず小さくなってしまいます。
    excelの画像の圧縮を無効にしてもダメでした。
    解決方法があればお願いします。

    • こんにちは
      バーコードの大きさは、基本的にはセル大きさに合わせるようになっています。
      QRコードは縦横比を固定してセルの縦・横の短い方に合わせ、QRコード以外は縦横比を固定せずにセルの大きさより少しだけ小さくなるようにしているはずなのですが・・・
      解決できるか分かりませんが、imgurなどの画像アップローダにキャプチャー画像をアップして、コメントにリンクを貼ってみてください。
      本当に解決できるか分かりませんので、あらかじめご了承ください。

    • すいません
      ちょっと個人的な都合で返信が遅れています。
      解決できるか分かりませんが、もう少々お待ちください

      • ありがとうございます。
        こちらでも色々とやっていますが、解決策が未だでていません。
        Mibarcodeと、windows10あるいはexcel2016の互換性が悪いのかと….

        • 下記コードではどうでしょうか?

          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
          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

          • エラー424「オブジェクトが必要です」がでました。
            デバックしてみるとiBar.Executeが黄色表示されますね

          • ※このコメント欄のやり取りを見てる方へ
            投稿者様とのやり取りの際は、新しい記事を作ってコードを貼り付けリンクを設定していましたが、現在は記事本文の追記のコードでとりあえず解決しています。

  • ご回答遅れてもうしわけありません。
    お仕事が落ち着いたのでコメントします!
    ありがとうございます!ばっちりと問題なく動きます。

  • QR-Codeのコード周りの余白を無くすことは出来ませんでしょうか?
    ラベル印刷に使用したく思っておりなるべく小さいイメージ画像を得て印刷時に余白を
    コントロールできればと思っております。

    またマイクロQRコードの対応予定はありますでしょうか?

    • ※管理人注:投稿いただいた名前をイニシャルに変更させていただきました。
      QRコード作成に関しましては、MiBarcodeというフリーソフトの機能で作成しているため、余白の調整を自動で行うのは困難です。
      またマイクロQRコードに関しても、MiBarcodeでは作成できないため、対応は困難です。
      お役に立てず申し訳ありません。

コメントする

目次
閉じる