エクセルにバーコードを画像で一括挿入する

この記事を作るにあたり参考にさせていただいたサイトです
バーコードの作成

JANコード、EANコード以外のバーコードも作成できる記事を下記にアップしました
フリーソフトを使ってバーコードを作成する方法

エクセルのリストにバーコード(JANコード・EANコード)を画像で一括挿入する方法をご紹介します。
※エクセル以外のソフト(フリーウェア・シェアウェアに限らず)は使いません。エクセルだけ有れば大丈夫です(アクセスも必要ありません)
※エクセル初心者でも使えるよう説明するつもりです

スポンサーリンク

下の画像のように一括でバーコード画像を挿入します。
元リスト

バーコード挿入済みリスト

①エクセルファイルの準備
今回紹介する方法は、JANコードやEANコードの入力されているセルを基準にして「何列隣り(となり)にバーコードを挿入する」という事を指定します
個別には指定できません。(行程を分ければ個別に出来ますが、エクセル初心者を対象に書いている記事ですので)
そのため、エクセルファイルの列構成はあらかじめ調整しておいてください(先頭から最後まで同じ列なら問題ありません)
また、縦に複数列有る場合でも、JANコードとバーコードを挿入する列の列数の関係が同じなら問題ありません
模範的なリスト1
模範的なリスト2

②VBAコードを標準モジュールに貼り付ける
「Alt」を押しながら「F11」を押してください
下のような画面が出てくると思います
赤枠で囲った部分のメニューが出ていない場合は「Ctrl」を押しながら「r」を押してください
VBEを立ち上げる

目的のファイル名の上で右クリック

「挿入」をクリック

「標準モジュール」をクリック
標準モジュールの挿入

すると右側に大きな白いスペースが現れたと思います
※↓画像の赤枠部分
標準モジュールの場所

このスペースに以下のコードをコピペしてください

Option Explicit
Function CHECKDIGIT(ByVal target As Range) As String
Dim strJAN As Integer
Dim i As Integer
Select Case Len(target)
Case 12, 13
i = (CInt(Mid(target, 2, 1)) + CInt(Mid(target, 4, 1)) + CInt(Mid(target, 6, 1)) + _
CInt(Mid(target, 8, 1)) + CInt(Mid(target, 10, 1)) + CInt(Mid(target, 12, 1))) * 3
i = i + CInt(Mid(target, 1, 1)) + CInt(Mid(target, 3, 1)) + CInt(Mid(target, 5, 1)) + _
CInt(Mid(target, 7, 1)) + CInt(Mid(target, 9, 1)) + CInt(Mid(target, 11, 1))
strJAN = Right(10 - CInt(Right(i, 1)), 1)
CHECKDIGIT = strJAN
Case 7, 8
i = (CInt(Mid(target, 1, 1)) + CInt(Mid(target, 3, 1)) + CInt(Mid(target, 5, 1)) _
+ CInt(Mid(target, 7, 1))) * 3
i = i + CInt(Mid(target, 2, 1)) + CInt(Mid(target, 4, 1)) + CInt(Mid(target, 6, 1))
strJAN = Right(10 - CInt(Right(i, 1)), 1)
CHECKDIGIT = strJAN
Case Else
Exit Function
End Select
End Function
Sub MYBARCODECREATE()
Application.ScreenUpdating = False
Dim myheadchar13, myleftodd13, mylefteven13, myrighteven13, myleftodd8, myrighteven8 As Variant
Dim c As Range
Dim mycode As String
Dim myhdch As String
Dim sh As Worksheet, shbar As Worksheet
Dim i, p, q, r, s, t, u, v, w, x, y, z As Integer
Dim h
myheadchar13 = Array("aaaaaa", "aababb", "aabbab", "aabbba", "abaabb", "abbaab", "abbbaa", "ababab", "ababba", "abbaba")
myleftodd13 = Array("2221121", "2211221", "2212211", "2111121", "2122211", "2112221", "2121111", "2111211", "2112111", "2221211")
mylefteven13 = Array("2122111", "2112211", "2211211", "2122221", "2211121", "2111221", "2222121", "2212221", "2221221", "2212111")
myrighteven13 = Array("1112212", "1122112", "1121122", "1222212", "1211122", "1221112", "1212222", "1222122", "1221222", "1112122")
myleftodd8 = Array("2221121", "2211221", "2212211", "2111121", "2122211", "2112221", "2121111", "2111211", "2112111", "2221211")
myrighteven8 = Array("1112212", "1122112", "1121122", "1222212", "1211122", "1221112", "1212222", "1222122", "1221222", "1112122")
i = 1
Set sh = ActiveSheet
For Each c In Selection
Select Case Len(c)
Case 8, 13
If CStr(Right(c, 1)) <> CHECKDIGIT(c) Then
c.Interior.Color = 16711680
MsgBox "CHECK DIGIT ERROR" & vbCrLf & c.Address(False, False)
i = i + 1
End If
If i > 1 Then
Exit Sub
End If
End Select
Next
If IMEStatus <> vbIMEModeOff Then
SendKeys "{kanji}"
End If
x = InputBox("何列右にバーコードを作成しますか?")
Worksheets.Add
ActiveSheet.Name = "mysh"
Set shbar = Worksheets("mysh")
Cells.Interior.Color = 16777215
Cells.ColumnWidth = 0.08
Rows("2:2").RowHeight = 15
Rows("3:3").RowHeight = 4.5
Rows("4:4").RowHeight = 4.5
Cells.Font.Size = 6
Range("Q3").NumberFormatLocal = "000000"
Range("BL3").NumberFormatLocal = "000000"
With Range("A3:K4")
.Merge
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.ShrinkToFit = True
End With
With Range("Q3:BD4")
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ShrinkToFit = True
End With
With Range("BL3:CY4")
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ShrinkToFit = True
End With
Range("M2:M3").Merge
Range("O2:O3").Merge
Range("BG2:BG3").Merge
Range("BI2:BI3").Merge
Range("DA2:DA3").Merge
Range("DC2:DC3").Merge
Rows("6:6").RowHeight = 15
Rows("7:7").RowHeight = 4.5
Rows("8:8").RowHeight = 4.5
Range("M6:M7").Merge
Range("O6:O7").Merge
Range("AS6:AS7").Merge
Range("AU6:AU7").Merge
Range("BY6:BY7").Merge
Range("CA6:CA7").Merge
With Range("Q7:AP8")
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ShrinkToFit = True
End With
With Range("AX7:BW8")
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ShrinkToFit = True
End With
Range("Q7").NumberFormatLocal = "0000"
Range("AX7").NumberFormatLocal = "0000"
sh.Activate
For Each c In Selection
If Len(c) = 12 Or Len(c) = 13 Then
mycode = "222222222222121"
myhdch = myheadchar13(Left(c, 1))
For s = 2 To 7
Select Case Mid(myhdch, s - 1, 1)
Case "a"
mycode = mycode & myleftodd13(CInt(Mid(c, s, 1)))
Case "b"
mycode = mycode & mylefteven13(CInt(Mid(c, s, 1)))
End Select
Next s
mycode = mycode & "21212"
For t = 8 To 12
mycode = mycode & myrighteven13(CInt(Mid(c, t, 1)))
Next t
mycode = mycode & myrighteven13(CInt(CHECKDIGIT(c)))
mycode = mycode & "121222222222222"
shbar.Range("A3").Value = Left(c, 1)
shbar.Range("Q3").Value = Mid(c, 2, 6)
shbar.Range("BL3").Value = Mid(c, 8, 5) & CHECKDIGIT(c)
For w = 1 To Len(mycode)
If Mid(mycode, w, 1) = 1 Then
shbar.Cells(2, w).Interior.Color = 0
End If
Next w
shbar.Range("A2:DO4").CopyPicture Appearance:=xlScreen, Format:=xlPicture
c.Offset(, x).PasteSpecial
With Selection
.ShapeRange.LockAspectRatio = msoFalse
.Height = c.Height - 4
.Width = c.Offset(0, x).Width - 4
.Left = c.Offset(0, x).Left + (c.Offset(0, x).Width - .Width) / 2
.Top = c.Offset(0, x).Top + (c.Offset(0, x).Height - .Height) / 2
End With
shbar.Cells.Interior.Color = 16777215
End If
If Len(c) = 7 Or Len(c) = 8 Then
mycode = "222222222222121"
For y = 1 To 4
mycode = mycode & myleftodd8(CInt(Mid(c, y, 1)))
Next y
mycode = mycode & "21212"
For z = 5 To 7
mycode = mycode & myrighteven8(CInt(Mid(c, z, 1)))
Next z
mycode = mycode & myrighteven8(CInt(CHECKDIGIT(c)))
mycode = mycode & "121222222222222"
For p = 1 To Len(mycode)
If Mid(mycode, p, 1) = 1 Then
shbar.Cells(6, p).Interior.Color = 0
End If
Next p
shbar.Range("Q7") = Left(c, 4)
shbar.Range("AX7") = Mid(c, 5, 3) & CHECKDIGIT(c)
shbar.Range("A6:CM8").CopyPicture Appearance:=xlScreen, Format:=xlPicture
c.Offset(, x).PasteSpecial
With Selection
.ShapeRange.LockAspectRatio = msoFalse
.Height = c.Height - 4
.Width = c.Offset(0, x).Width - 4
.Left = c.Offset(0, x).Left + (c.Offset(0, x).Width - .Width) / 2
.Top = c.Offset(0, x).Top + (c.Offset(0, x).Height - .Height) / 2
End With
shbar.Cells.Interior.Color = 16777215
End If
Next c
Application.DisplayAlerts = False
Worksheets("mysh").Delete
Application.DisplayAlerts = True
End Sub

③今貼り付けたプログラムを実行する
バーコードを作りたいJANコード・EANコードを選択してください
1列の場合はそのままマウスをドラッグして範囲選択
範囲を選択

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

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

「MYBARCODECREATE」を選択し「実行」をクリックしてください
(「何列右にバーコードを作成しますか?」と聞かれますので、上の画像のように2列右に挿入したい場合は「2」と入力してください。「-2」と入力すると2列左にバーコードを挿入しようとしますが、A列より左は無いためエラーになります。「-1」と入力するとA列に挿入します)
バーコード挿入を実行

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

以前にフリーソフトを使ったバーコードの作成方法を別のブログで紹介したことがあるのですが、パソコンや環境によっては使えないことがあるようでした。

今回紹介した方法なら、環境に関係無くエクセルだけでバーコードができるはずなので活用してみてください。
なお、当ブログの記事を用いることによって被った損害・損失に対しては一切の責任を負いかねますのであらかじめご了承下さい。

スポンサーリンク

エクセルにバーコードを画像で一括挿入する」への45件のフィードバック

  1. TK

    はじめまして。
    バーコード作成方法を探していてこちらにお邪魔させて頂きました。
    非常にわかりやすく、敷居の低いご説明ありがとうございました。
    大変に助かりました。

    tk

    返信
  2. TK

    JANバーコードのみ(13桁数字なし)は可能でしょうか。

    お世話になったそばから大変に恐縮ですが。

    返信
    1. 斜め上ニュース管理人 投稿作成者

      下記のコードで数字無しのバーコードができると思います
      ご活用ください

      Option Explicit
      Function CHECKDIGIT(ByVal target As Range) As String
      Dim strJAN As Integer
      Dim i As Integer
      Select Case Len(target)
      Case 12, 13
      i = (CInt(Mid(target, 2, 1)) + CInt(Mid(target, 4, 1)) + CInt(Mid(target, 6, 1)) + _
      CInt(Mid(target, 8, 1)) + CInt(Mid(target, 10, 1)) + CInt(Mid(target, 12, 1))) * 3
      i = i + CInt(Mid(target, 1, 1)) + CInt(Mid(target, 3, 1)) + CInt(Mid(target, 5, 1)) + _
      CInt(Mid(target, 7, 1)) + CInt(Mid(target, 9, 1)) + CInt(Mid(target, 11, 1))
      strJAN = Right(10 – CInt(Right(i, 1)), 1)
      CHECKDIGIT = strJAN
      Case 7, 8
      i = (CInt(Mid(target, 1, 1)) + CInt(Mid(target, 3, 1)) + CInt(Mid(target, 5, 1)) _
      + CInt(Mid(target, 7, 1))) * 3
      i = i + CInt(Mid(target, 2, 1)) + CInt(Mid(target, 4, 1)) + CInt(Mid(target, 6, 1))
      strJAN = Right(10 – CInt(Right(i, 1)), 1)
      CHECKDIGIT = strJAN
      Case Else
      Exit Function
      End Select
      End Function
      Sub MYBARCODECREATE()
      Application.ScreenUpdating = False
      Dim myheadchar13, myleftodd13, mylefteven13, myrighteven13, myleftodd8, myrighteven8 As Variant
      Dim c As Range
      Dim mycode As String
      Dim myhdch As String
      Dim sh As Worksheet, shbar As Worksheet
      Dim i, p, q, r, s, t, u, v, w, x, y, z As Integer
      Dim h
      myheadchar13 = Array(“aaaaaa”, “aababb”, “aabbab”, “aabbba”, “abaabb”, “abbaab”, “abbbaa”, “ababab”, “ababba”, “abbaba”)
      myleftodd13 = Array(“2221121”, “2211221”, “2212211”, “2111121”, “2122211”, “2112221”, “2121111”, “2111211”, “2112111”, “2221211”)
      mylefteven13 = Array(“2122111”, “2112211”, “2211211”, “2122221”, “2211121”, “2111221”, “2222121”, “2212221”, “2221221”, “2212111”)
      myrighteven13 = Array(“1112212”, “1122112”, “1121122”, “1222212”, “1211122”, “1221112”, “1212222”, “1222122”, “1221222”, “1112122”)
      myleftodd8 = Array(“2221121”, “2211221”, “2212211”, “2111121”, “2122211”, “2112221”, “2121111”, “2111211”, “2112111”, “2221211”)
      myrighteven8 = Array(“1112212”, “1122112”, “1121122”, “1222212”, “1211122”, “1221112”, “1212222”, “1222122”, “1221222”, “1112122”)
      i = 1
      Set sh = ActiveSheet
      For Each c In Selection
      Select Case Len(c)
      Case 8, 13
      If CStr(Right(c, 1)) <> CHECKDIGIT(c) Then
      c.Interior.Color = 16711680
      MsgBox “CHECK DIGIT ERROR” & vbCrLf & c.Address(False, False)
      i = i + 1
      End If
      If i > 1 Then
      Exit Sub
      End If
      End Select
      Next
      x = InputBox(“column (-100~100)”)
      Worksheets.Add
      ActiveSheet.Name = “mysh”
      Set shbar = Worksheets(“mysh”)
      Cells.Interior.Color = 16777215
      Cells.ColumnWidth = 0.08
      Rows(“2:2”).RowHeight = 15
      Rows(“3:3”).RowHeight = 4.5
      Rows(“4:4”).RowHeight = 4.5
      Cells.Font.Size = 6
      Range(“Q3”).NumberFormatLocal = “000000”
      Range(“BL3”).NumberFormatLocal = “000000”
      With Range(“A3:K4”)
      .Merge
      .HorizontalAlignment = xlRight
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      With Range(“Q3:BD4”)
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      With Range(“BL3:CY4”)
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      Range(“M2:M3”).Merge
      Range(“O2:O3”).Merge
      Range(“BG2:BG3”).Merge
      Range(“BI2:BI3”).Merge
      Range(“DA2:DA3”).Merge
      Range(“DC2:DC3”).Merge
      Rows(“6:6”).RowHeight = 15
      Rows(“7:7”).RowHeight = 4.5
      Rows(“8:8”).RowHeight = 4.5
      Range(“M6:M7”).Merge
      Range(“O6:O7”).Merge
      Range(“AS6:AS7”).Merge
      Range(“AU6:AU7”).Merge
      Range(“BY6:BY7”).Merge
      Range(“CA6:CA7”).Merge
      With Range(“Q7:AP8”)
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      With Range(“AX7:BW8”)
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      Range(“Q7”).NumberFormatLocal = “0000”
      Range(“AX7”).NumberFormatLocal = “0000”
      sh.Activate
      For Each c In Selection
      If Len(c) = 12 Or Len(c) = 13 Then
      mycode = “222222222222121”
      myhdch = myheadchar13(Left(c, 1))
      For s = 2 To 7
      Select Case Mid(myhdch, s – 1, 1)
      Case “a”
      mycode = mycode & myleftodd13(CInt(Mid(c, s, 1)))
      Case “b”
      mycode = mycode & mylefteven13(CInt(Mid(c, s, 1)))
      End Select
      Next s
      mycode = mycode & “21212”
      For t = 8 To 12
      mycode = mycode & myrighteven13(CInt(Mid(c, t, 1)))
      Next t
      mycode = mycode & myrighteven13(CInt(CHECKDIGIT(c)))
      mycode = mycode & “121222222222222”
      ‘shbar.Range(“A3”).Value = Left(c, 1)
      ‘shbar.Range(“Q3”).Value = Mid(c, 2, 6)
      ‘shbar.Range(“BL3”).Value = Mid(c, 8, 5) & CHECKDIGIT(c)
      For w = 1 To Len(mycode)
      If Mid(mycode, w, 1) = 1 Then
      shbar.Cells(2, w).Interior.Color = 0
      End If
      Next w
      shbar.Range(“A2:DO4”).CopyPicture Appearance:=xlScreen, Format:=xlPicture
      c.Offset(, x).PasteSpecial
      With Selection
      .ShapeRange.LockAspectRatio = msoFalse
      .Height = c.Height – 4
      .Width = c.Offset(0, x).Width – 4
      .Left = c.Offset(0, x).Left + (c.Offset(0, x).Width – .Width) / 2
      .Top = c.Offset(0, x).Top + (c.Offset(0, x).Height – .Height) / 2
      End With
      shbar.Cells.Interior.Color = 16777215
      End If
      If Len(c) = 7 Or Len(c) = 8 Then
      mycode = “222222222222121”
      For y = 1 To 4
      mycode = mycode & myleftodd8(CInt(Mid(c, y, 1)))
      Next y
      mycode = mycode & “21212”
      For z = 5 To 7
      mycode = mycode & myrighteven8(CInt(Mid(c, z, 1)))
      Next z
      mycode = mycode & myrighteven8(CInt(CHECKDIGIT(c)))
      mycode = mycode & “121222222222222”
      For p = 1 To Len(mycode)
      If Mid(mycode, p, 1) = 1 Then
      shbar.Cells(6, p).Interior.Color = 0
      End If
      Next p
      ‘shbar.Range(“Q7”) = Left(c, 4)
      ‘shbar.Range(“AX7”) = Mid(c, 5, 3) & CHECKDIGIT(c)
      shbar.Range(“A6:CM8”).CopyPicture Appearance:=xlScreen, Format:=xlPicture
      c.Offset(, x).PasteSpecial
      With Selection
      .ShapeRange.LockAspectRatio = msoFalse
      .Height = c.Height – 4
      .Width = c.Offset(0, x).Width – 4
      .Left = c.Offset(0, x).Left + (c.Offset(0, x).Width – .Width) / 2
      .Top = c.Offset(0, x).Top + (c.Offset(0, x).Height – .Height) / 2
      End With
      shbar.Cells.Interior.Color = 16777215
      End If
      Next c
      Application.DisplayAlerts = False
      Worksheets(“mysh”).Delete
      Application.DisplayAlerts = True
      End Sub

      返信
      1. tn

        バーコードを表示させたまま他のPCに渡せるEXCELを生成する方法を探し、こちらの方法を利用させていただきました。EXCELのみで、簡単に実現でき、本当に有りがたく思っております。
        ご紹介いただいた数字なしバージョンのコードについて、Internet Explorer 11からEXCEL2013のVBAモジュールにコピー・ペーストすると、シングル・ダブルクォーテーションが全角に、マイナス記号がクエスチョン記号になり、修正が必要でした。
        おそらく自動的なエスケープ処理の結果と思います。愚見ながら申し添えます。

        返信
        1. 斜め上ニュース管理人 投稿作成者

          アドバイスいただきありがとうございます。
          私のスキルでは様々なPCの環境に対応させることは難しいかもしれませんが、ご指摘いただいたことを記憶しておき、少しでもみなさんが使いやすいようにしていきます。

          返信
  3. モナド

    はじめまして。
    仕事でJANコードを印刷した商品リストを作る必要があり、こちらでご紹介頂いた方法で試したところ、バッチリでした。
    ありがとうございました。

    返信
  4. ichigo

    はじめまして。
    凄く判りやすくて、感激です。
    ありがとうございましたm(_”_)m

    返信
  5. NN

    はじめまして、自店舗の価格表作成に大変重宝させていただいております。
    一点お伺いしたいのですが、0から始まるインストアコードのバーコード画像変換は
    出来なかったのですが何か解決する方法はございますでしょうか?

    お忙しいところ、申し訳ありませんがご教授頂ければ幸いです。

    返信
    1. 斜め上ニュース管理人 投稿作成者

      遅くなりまして申し訳ありません。
      セルの表示形式を「文字列」にして、先頭の文字は「0」になっているでしょうか?
      セルの値は、見た目の値と実際の値が異なっていることがありますので、その点を確かめてみてください。

      返信
  6. ofa

    初めまして。
    仕事でJANコードを入れた表を作成したくて、お邪魔しました。
    初心者でも分かりやすく教えていただいてありがとうございます。
    只、たびたびエラー1004が出てしまうのですが、原因は何でしょうか。
    教えていただければと思います。

    返信
    1. 斜め上ニュース管理人 投稿作成者

      返信遅くなりまして申し訳ありません。
      エラー1004を調べてみたところ、様々な状況で出るようです。
      どういった内容のメッセージが出るのかも教えていただければ幸いです。
      なお、私はスキルがそれほど高くないので、解決できないことも結構あると思いますので、その点はあらかじめご了承ください。

      返信
  7. RI

    とてもわかりやすい記事をありがとうございます。
    officeforMacのExcelを利用していますが、
    記載のコードでバーコード画像を一括挿入することができました。
    ただ、マクロで自動挿入される画像のサイズがかなり小さいです(縦が短く幅広)。
    セルのサイズを拡大した上でマクロを実行すると、
    自動挿入の画像も自動拡大となりますが、文字や線がぼやけてします。
    挿入の際のサイズを一定にして、画像がぼやけないようにしたいのですが、可能でしょうか?
    VBAマクロ、本当に初心者なもので、教えていただければ幸いです。
    お忙しいところ恐縮ですが、よろしくお願い致します。

    返信
    1. 斜め上ニュース管理人 投稿作成者

      こんにちは
      macは触ったことがないのでどのような原因か分からないのですが、バーコードの元画像を10倍サイズで作るコードを下記に記載しておきます。
      ちなみにコメントのところを変えると調整できます
      試してみてください。

      Option Explicit
      Function CHECKDIGIT(ByVal target As Range) As String
      Dim strJAN As Integer
      Dim i As Integer
      Select Case Len(target)
      Case 12, 13
      i = (CInt(Mid(target, 2, 1)) + CInt(Mid(target, 4, 1)) + CInt(Mid(target, 6, 1)) + _
      CInt(Mid(target, 8, 1)) + CInt(Mid(target, 10, 1)) + CInt(Mid(target, 12, 1))) * 3
      i = i + CInt(Mid(target, 1, 1)) + CInt(Mid(target, 3, 1)) + CInt(Mid(target, 5, 1)) + _
      CInt(Mid(target, 7, 1)) + CInt(Mid(target, 9, 1)) + CInt(Mid(target, 11, 1))
      strJAN = Right(10 – CInt(Right(i, 1)), 1)
      CHECKDIGIT = strJAN
      Case 7, 8
      i = (CInt(Mid(target, 1, 1)) + CInt(Mid(target, 3, 1)) + CInt(Mid(target, 5, 1)) _
      + CInt(Mid(target, 7, 1))) * 3
      i = i + CInt(Mid(target, 2, 1)) + CInt(Mid(target, 4, 1)) + CInt(Mid(target, 6, 1))
      strJAN = Right(10 – CInt(Right(i, 1)), 1)
      CHECKDIGIT = strJAN
      Case Else
      Exit Function
      End Select
      End Function
      Sub MYBARCODECREATE_formac()
      Application.ScreenUpdating = False
      Dim myheadchar13, myleftodd13, mylefteven13, myrighteven13, myleftodd8, myrighteven8 As Variant
      Dim c As Range
      Dim mycode As String
      Dim myhdch As String
      Dim sh As Worksheet, shbar As Worksheet
      Dim i, p, q, r, s, t, u, v, w, x, y, z As Integer
      Dim h
      myheadchar13 = Array(“aaaaaa”, “aababb”, “aabbab”, “aabbba”, “abaabb”, “abbaab”, “abbbaa”, “ababab”, “ababba”, “abbaba”)
      myleftodd13 = Array(“2221121”, “2211221”, “2212211”, “2111121”, “2122211”, “2112221”, “2121111”, “2111211”, “2112111”, “2221211”)
      mylefteven13 = Array(“2122111”, “2112211”, “2211211”, “2122221”, “2211121”, “2111221”, “2222121”, “2212221”, “2221221”, “2212111”)
      myrighteven13 = Array(“1112212”, “1122112”, “1121122”, “1222212”, “1211122”, “1221112”, “1212222”, “1222122”, “1221222”, “1112122”)
      myleftodd8 = Array(“2221121”, “2211221”, “2212211”, “2111121”, “2122211”, “2112221”, “2121111”, “2111211”, “2112111”, “2221211”)
      myrighteven8 = Array(“1112212”, “1122112”, “1121122”, “1222212”, “1211122”, “1221112”, “1212222”, “1222122”, “1221222”, “1112122”)
      i = 1
      Set sh = ActiveSheet
      For Each c In Selection
      Select Case Len(c)
      Case 8, 13
      If CStr(Right(c, 1)) <> CHECKDIGIT(c) Then
      c.Interior.Color = 16711680
      MsgBox “CHECK DIGIT ERROR” & vbCrLf & c.Address(False, False)
      i = i + 1
      End If
      If i > 1 Then
      Exit Sub
      End If
      End Select
      Next
      x = InputBox(“column (-100~100)”)
      Worksheets.Add
      ActiveSheet.Name = “mysh”
      Set shbar = Worksheets(“mysh”)
      Cells.Interior.Color = 16777215
      Cells.ColumnWidth = 0.8 ‘・・・列の幅(JAN8・JAN13共通)
      Rows(“2:2”).RowHeight = 150 ‘・・・メインとなるバーコードの高さ(JAN13)
      Rows(“3:3”).RowHeight = 45 ‘・・・センター(と両端)のバーコードの高さ(JAN13)
      Rows(“4:4”).RowHeight = 45 ‘・・・両端のバーコードの高さ(JAN13)
      Cells.Font.Size = 60 ‘・・・文字のサイズ(JAN8・JAN13共通)
      Range(“Q3”).NumberFormatLocal = “000000”
      Range(“BL3”).NumberFormatLocal = “000000”
      With Range(“A3:K4”)
      .Merge
      .HorizontalAlignment = xlRight
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      With Range(“Q3:BD4”)
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      With Range(“BL3:CY4”)
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      Range(“M2:M3”).Merge
      Range(“O2:O3”).Merge
      Range(“BG2:BG3”).Merge
      Range(“BI2:BI3”).Merge
      Range(“DA2:DA3”).Merge
      Range(“DC2:DC3”).Merge
      Rows(“6:6”).RowHeight = 150 ‘・・・メインとなるバーコードの高さ(JAN8)
      Rows(“7:7”).RowHeight = 45 ‘・・・センター(と両端)のバーコードの高さ(JAN8)
      Rows(“8:8”).RowHeight = 45 ‘・・・両端のバーコードの高さ(JAN13)
      Range(“M6:M7”).Merge
      Range(“O6:O7”).Merge
      Range(“AS6:AS7”).Merge
      Range(“AU6:AU7”).Merge
      Range(“BY6:BY7”).Merge
      Range(“CA6:CA7”).Merge
      With Range(“Q7:AP8”)
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      With Range(“AX7:BW8”)
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      Range(“Q7”).NumberFormatLocal = “0000”
      Range(“AX7”).NumberFormatLocal = “0000”
      sh.Activate
      For Each c In Selection
      If Len(c) = 12 Or Len(c) = 13 Then
      mycode = “222222222222121”
      myhdch = myheadchar13(Left(c, 1))
      For s = 2 To 7
      Select Case Mid(myhdch, s – 1, 1)
      Case “a”
      mycode = mycode & myleftodd13(CInt(Mid(c, s, 1)))
      Case “b”
      mycode = mycode & mylefteven13(CInt(Mid(c, s, 1)))
      End Select
      Next s
      mycode = mycode & “21212”
      For t = 8 To 12
      mycode = mycode & myrighteven13(CInt(Mid(c, t, 1)))
      Next t
      mycode = mycode & myrighteven13(CInt(CHECKDIGIT(c)))
      mycode = mycode & “121222222222222”
      shbar.Range(“A3”).Value = Left(c, 1)
      shbar.Range(“Q3”).Value = Mid(c, 2, 6)
      shbar.Range(“BL3”).Value = Mid(c, 8, 5) & CHECKDIGIT(c)
      For w = 1 To Len(mycode)
      If Mid(mycode, w, 1) = 1 Then
      shbar.Cells(2, w).Interior.Color = 0
      End If
      Next w
      shbar.Range(“A2:DO4”).CopyPicture Appearance:=xlScreen, Format:=xlPicture
      c.Offset(, x).PasteSpecial
      With Selection
      .ShapeRange.LockAspectRatio = msoFalse
      .Height = c.Height – 4
      .Width = c.Offset(0, x).Width – 4
      .Left = c.Offset(0, x).Left + (c.Offset(0, x).Width – .Width) / 2
      .Top = c.Offset(0, x).Top + (c.Offset(0, x).Height – .Height) / 2
      End With
      shbar.Cells.Interior.Color = 16777215
      End If
      If Len(c) = 7 Or Len(c) = 8 Then
      mycode = “222222222222121”
      For y = 1 To 4
      mycode = mycode & myleftodd8(CInt(Mid(c, y, 1)))
      Next y
      mycode = mycode & “21212”
      For z = 5 To 7
      mycode = mycode & myrighteven8(CInt(Mid(c, z, 1)))
      Next z
      mycode = mycode & myrighteven8(CInt(CHECKDIGIT(c)))
      mycode = mycode & “121222222222222”
      For p = 1 To Len(mycode)
      If Mid(mycode, p, 1) = 1 Then
      shbar.Cells(6, p).Interior.Color = 0
      End If
      Next p
      shbar.Range(“Q7”) = Left(c, 4)
      shbar.Range(“AX7”) = Mid(c, 5, 3) & CHECKDIGIT(c)
      shbar.Range(“A6:CM8”).CopyPicture Appearance:=xlScreen, Format:=xlPicture
      c.Offset(, x).PasteSpecial
      With Selection
      .ShapeRange.LockAspectRatio = msoFalse
      .Height = c.Height – 4
      .Width = c.Offset(0, x).Width – 4
      .Left = c.Offset(0, x).Left + (c.Offset(0, x).Width – .Width) / 2
      .Top = c.Offset(0, x).Top + (c.Offset(0, x).Height – .Height) / 2
      End With
      shbar.Cells.Interior.Color = 16777215
      End If
      Next c
      Application.DisplayAlerts = False
      Worksheets(“mysh”).Delete
      Application.DisplayAlerts = True
      End Sub

      返信
      1. RI

        確認が遅く、お礼が遅くなってしまい失礼いたしました。
        丁寧にご教示いただき、ありがとうございます。早速試してみます。

        返信
  8. H.Y

    このコードを入れて実行するとこのようなエラーが出るのですが、どう対処すればよいでしょうか。

    実行時エラー 1004 RangeクラスのPasteSpecialメソッドが失敗しました。

    ディバックを押すと c.Offset(, x).PasteSpecialの部分が黄色く光ります。

    返信
    1. 斜め上ニュース管理人 投稿作成者

      こんにちは
      エラーを回避するためにちょっとだけコードを足してみましたので、下記のコードを貼り付けて再度試してください。
      ちなみにそれでもエラーが出る場合には私の知識では対処できない可能性も高いので、その点についてはあらかじめご了承ください

      Option Explicit
      Function CHECKDIGIT(ByVal target As Range) As String
      Dim strJAN As Integer
      Dim i As Integer
      Select Case Len(target)
      Case 12, 13
      i = (CInt(Mid(target, 2, 1)) + CInt(Mid(target, 4, 1)) + CInt(Mid(target, 6, 1)) + _
      CInt(Mid(target, 8, 1)) + CInt(Mid(target, 10, 1)) + CInt(Mid(target, 12, 1))) * 3
      i = i + CInt(Mid(target, 1, 1)) + CInt(Mid(target, 3, 1)) + CInt(Mid(target, 5, 1)) + _
      CInt(Mid(target, 7, 1)) + CInt(Mid(target, 9, 1)) + CInt(Mid(target, 11, 1))
      strJAN = Right(10 – CInt(Right(i, 1)), 1)
      CHECKDIGIT = strJAN
      Case 7, 8
      i = (CInt(Mid(target, 1, 1)) + CInt(Mid(target, 3, 1)) + CInt(Mid(target, 5, 1)) _
      + CInt(Mid(target, 7, 1))) * 3
      i = i + CInt(Mid(target, 2, 1)) + CInt(Mid(target, 4, 1)) + CInt(Mid(target, 6, 1))
      strJAN = Right(10 – CInt(Right(i, 1)), 1)
      CHECKDIGIT = strJAN
      Case Else
      Exit Function
      End Select
      End Function
      Sub MYBARCODECREATE_151026()
      Application.ScreenUpdating = False

      Application.EnableEvents = False

      Dim myheadchar13, myleftodd13, mylefteven13, myrighteven13, myleftodd8, myrighteven8 As Variant
      Dim c As Range
      Dim mycode As String
      Dim myhdch As String
      Dim sh As Worksheet, shbar As Worksheet
      Dim i, p, q, r, s, t, u, v, w, x, y, z As Integer
      Dim h
      myheadchar13 = Array(“aaaaaa”, “aababb”, “aabbab”, “aabbba”, “abaabb”, “abbaab”, “abbbaa”, “ababab”, “ababba”, “abbaba”)
      myleftodd13 = Array(“2221121”, “2211221”, “2212211”, “2111121”, “2122211”, “2112221”, “2121111”, “2111211”, “2112111”, “2221211”)
      mylefteven13 = Array(“2122111”, “2112211”, “2211211”, “2122221”, “2211121”, “2111221”, “2222121”, “2212221”, “2221221”, “2212111”)
      myrighteven13 = Array(“1112212”, “1122112”, “1121122”, “1222212”, “1211122”, “1221112”, “1212222”, “1222122”, “1221222”, “1112122”)
      myleftodd8 = Array(“2221121”, “2211221”, “2212211”, “2111121”, “2122211”, “2112221”, “2121111”, “2111211”, “2112111”, “2221211”)
      myrighteven8 = Array(“1112212”, “1122112”, “1121122”, “1222212”, “1211122”, “1221112”, “1212222”, “1222122”, “1221222”, “1112122”)
      i = 1
      Set sh = ActiveSheet
      For Each c In Selection
      Select Case Len(c)
      Case 8, 13
      If CStr(Right(c, 1)) <> CHECKDIGIT(c) Then
      c.Interior.Color = 16711680
      MsgBox “CHECK DIGIT ERROR” & vbCrLf & c.Address(False, False)
      i = i + 1
      End If
      If i > 1 Then
      Exit Sub
      End If
      End Select
      Next
      x = InputBox(“column (-100~100)”)
      Worksheets.Add
      ActiveSheet.Name = “mysh”
      Set shbar = Worksheets(“mysh”)
      Cells.Interior.Color = 16777215
      Cells.ColumnWidth = 0.08
      Rows(“2:2”).RowHeight = 15
      Rows(“3:3”).RowHeight = 4.5
      Rows(“4:4”).RowHeight = 4.5
      Cells.Font.Size = 6
      Range(“Q3”).NumberFormatLocal = “000000”
      Range(“BL3”).NumberFormatLocal = “000000”
      With Range(“A3:K4”)
      .Merge
      .HorizontalAlignment = xlRight
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      With Range(“Q3:BD4”)
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      With Range(“BL3:CY4”)
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      Range(“M2:M3”).Merge
      Range(“O2:O3”).Merge
      Range(“BG2:BG3”).Merge
      Range(“BI2:BI3”).Merge
      Range(“DA2:DA3”).Merge
      Range(“DC2:DC3”).Merge
      Rows(“6:6”).RowHeight = 15
      Rows(“7:7”).RowHeight = 4.5
      Rows(“8:8”).RowHeight = 4.5
      Range(“M6:M7”).Merge
      Range(“O6:O7”).Merge
      Range(“AS6:AS7”).Merge
      Range(“AU6:AU7”).Merge
      Range(“BY6:BY7”).Merge
      Range(“CA6:CA7”).Merge
      With Range(“Q7:AP8”)
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      With Range(“AX7:BW8”)
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .ShrinkToFit = True
      End With
      Range(“Q7”).NumberFormatLocal = “0000”
      Range(“AX7”).NumberFormatLocal = “0000”
      sh.Activate
      For Each c In Selection
      If Len(c) = 12 Or Len(c) = 13 Then
      mycode = “222222222222121”
      myhdch = myheadchar13(Left(c, 1))
      For s = 2 To 7
      Select Case Mid(myhdch, s – 1, 1)
      Case “a”
      mycode = mycode & myleftodd13(CInt(Mid(c, s, 1)))
      Case “b”
      mycode = mycode & mylefteven13(CInt(Mid(c, s, 1)))
      End Select
      Next s
      mycode = mycode & “21212”
      For t = 8 To 12
      mycode = mycode & myrighteven13(CInt(Mid(c, t, 1)))
      Next t
      mycode = mycode & myrighteven13(CInt(CHECKDIGIT(c)))
      mycode = mycode & “121222222222222”
      shbar.Range(“A3”).Value = Left(c, 1)
      shbar.Range(“Q3”).Value = Mid(c, 2, 6)
      shbar.Range(“BL3”).Value = Mid(c, 8, 5) & CHECKDIGIT(c)
      For w = 1 To Len(mycode)
      If Mid(mycode, w, 1) = 1 Then
      shbar.Cells(2, w).Interior.Color = 0
      End If
      Next w
      shbar.Range(“A2:DO4”).CopyPicture Appearance:=xlScreen, Format:=xlPicture
      c.Offset(, x).PasteSpecial
      With Selection
      .ShapeRange.LockAspectRatio = msoFalse
      .Height = c.Height – 4
      .Width = c.Offset(0, x).Width – 4
      .Left = c.Offset(0, x).Left + (c.Offset(0, x).Width – .Width) / 2
      .Top = c.Offset(0, x).Top + (c.Offset(0, x).Height – .Height) / 2
      End With
      shbar.Cells.Interior.Color = 16777215
      End If
      If Len(c) = 7 Or Len(c) = 8 Then
      mycode = “222222222222121”
      For y = 1 To 4
      mycode = mycode & myleftodd8(CInt(Mid(c, y, 1)))
      Next y
      mycode = mycode & “21212”
      For z = 5 To 7
      mycode = mycode & myrighteven8(CInt(Mid(c, z, 1)))
      Next z
      mycode = mycode & myrighteven8(CInt(CHECKDIGIT(c)))
      mycode = mycode & “121222222222222”
      For p = 1 To Len(mycode)
      If Mid(mycode, p, 1) = 1 Then
      shbar.Cells(6, p).Interior.Color = 0
      End If
      Next p
      shbar.Range(“Q7”) = Left(c, 4)
      shbar.Range(“AX7”) = Mid(c, 5, 3) & CHECKDIGIT(c)
      shbar.Range(“A6:CM8”).CopyPicture Appearance:=xlScreen, Format:=xlPicture
      c.Offset(, x).PasteSpecial
      With Selection
      .ShapeRange.LockAspectRatio = msoFalse
      .Height = c.Height – 4
      .Width = c.Offset(0, x).Width – 4
      .Left = c.Offset(0, x).Left + (c.Offset(0, x).Width – .Width) / 2
      .Top = c.Offset(0, x).Top + (c.Offset(0, x).Height – .Height) / 2
      End With
      shbar.Cells.Interior.Color = 16777215
      End If
      Next c
      Application.DisplayAlerts = False
      Worksheets(“mysh”).Delete
      Application.DisplayAlerts = True

      Application.EnableEvents = True

      End Sub

      返信
      1. I

        突然、 RangeクラスのPasteSpecialメソッドが失敗しました。
        ディバックを押すと c.Offset(, x).PasteSpecialの部分が黄色く光ります。といったエラー状態が出現しました。2年近く利用して全く問題ありませんでした。原因は不明ですがこの修正コードで救われました。ー(マイナス)が全角なので赤くなりますが-マイナス(半角)なら問題なく利用可能です。
        問題は私のPCの場合は、バーコードは1000点でもできるのですが、貼り付けるのに500点で切り捨てられることです。
        別に有料でもいいのでちゃんとしたバーコード作成ソフトがあるといいです。発注書を作成するのにヒヤヒヤです。

        返信
        1. I

          やはりだめでした。バーコード作成できませんでした。
          バーコード作成ソフトを探します。

          返信
          1. 斜め上ニュース管理人 投稿作成者

            ※コメントを見てる方へ
            メール等でやり取りしていましたが、最終的に解決ができませんでした。

  9. ym

    はじめまして。
    超丁寧解説、ありがとうございます。

    質問です。
    こちらは、
    code128 コードC
    には、対応しますでしょかう?

    よろしくお願いいたします。

    返信
    1. quietriotgreenday 投稿作成者

      こんにちは
      申し訳ありませんが、こちらの記事のコードではJANコードとEANコードしか作れません。
      現在Mibarcdというフリーソフトとエクセルで一括作成する記事を書いておりまして、近日(おおむねか1ヶ月以内)公開できるかと思います。
      Mibarcdで作れるバーコードは全て作れるようになると思いますので、その記事がアップされましたらそちらをお使いください。

      返信
      1. ym

        ご回答ありがとうございます。
        了解でございます。

        > 現在Mibarcdというフリーソフトとエクセル...
        期待しております。

        よろしくお願いいたします。

        返信
  10. 333444

    はじめまして。JANコードをバーコードに一括変換できました。
    助かりました。ありがとうございます。ひとつ質問があります。
    A4サイズに印刷するときに、バーコードと商品名だけを縦に2列に又は、3列に並べることはできますか?
    1列だと行番号が500以上もあるので数十ページにもなります
    効率の良い並べ方を教えて頂けないでしょうか。
    ワードの段組みのようにしたいのですが、エクセルでも簡単に出来ますか?。
    操作方法がわかりません。よろしくお願いします。

    返信
    1. 斜め上ニュース管理人 投稿作成者

      こんにちは
      下記リンクに記事をアップしました。
      http://nanameue-news.com/2015/11/08/471/
      ワードの段組みをイメージされているようですので、そのままワードでの段組みでの印刷方法を紹介しています。
      ご活用ください。

      返信
  11. 野良犬のパルエ

    とてもわかりやすかったです!
    QRコード2のやり方があればぜひ教えてください!

    返信
    1. 斜め上ニュース管理人 投稿作成者

      こんにちは
      フリーソフトを使って一括でQR2も作れる記事を近日アップする予定です。
      11月中にはアップする予定ですので、そちらをご利用ください。

      返信
  12. イトウ

    3千個のJANに対して、実行したら、5分間をたったまま、今だにアイドル状態になりました。
    メモリコントロールか、処理をもっと軽くするか、どうしたら宜しいでしょうか。
    (数少ないJANに対しては、うまく対応出来てます)

    返信
    1. イトウ

      追記です。
      3000個JANの場合、8分をかかりました。
      MAC環境Office 2011 でちゃんと動きます。
      ありがとうございました。

      返信
      1. 斜め上ニュース管理人 投稿作成者

        使用例含めてのご報告ありがとうございます。
        処理を軽くする等の方法は私の知識では中々難しいかと思いますので、あしからずご了承ください。

        返信
        1. RY

          初めまして
          エクセル2013でマクロを実行したところコンパイルエラーと表記されました
          Sub MYBARCODECREATE()
          の部分が黄色くなっています。

          対処方法はございますでしょうか

          返信
          1. 斜め上ニュース管理人 投稿作成者

            こんにちは
            ちょっと解決できるかどうは分からないのですが・・・
            おそらく「コンパイルエラー」以外にも何がしかメッセージが出てると思います。
            それを教えていただけますか?
            ちなみに個人的なことなのですが、年度末の月末でかなり忙しいため返信が遅れる可能性が高いので、申し訳ありませんが悪しからずご了承ください。

        2. イトウ

          いつもご丁寧に回答頂き、ありがとうございました。
          結構使いやすいプログラムです。
          何度もたすかりました。
          ありがとうございます。

          返信
        3. I

          3000個JANは作成できました。しかし、EXCELに貼り付けると図が大きすぎて切り捨てられるとのメッセージがでて387個しか貼り付けができません。10回にわけて貼り付けるしか手段はないのでようか。

          返信
        4. I

          JAN3000個のバーコードができました。私の使用しているフリーソフトでは、実際2時間以上かかりますので、このソフトの方が何回か分けて貼り付けることができるので大変助かります。しかし、もっと効率的にバーコードを作成する手段がないのでしょうか。アクセスを利用しても結局同じ状態になるのでしょうか。

          返信
  13. M

    はじめて本格的なマクロに挑戦しました。
    指南通りに実行したところ、無事バーコードの画像が生成されました。

    社内で導入するにあたり、稼働をかけず、安全に確実にシンプルに管理する手法としては素晴らしいマクロの記述方法かと思います。

    ありがとうございました。

    返信
  14. けいじ

    コード5ケタでも バーコードを作成したいのですが、どうすればよいでしょうか

    返信
  15. code128

    当方マクロ等は素人だったのですが、斜め上ニュース管理人様のレクチャーでJAN/EANコードを作成することができました!ですが、仕事上どうしてもエクセルのマクロのみ(先日ご紹介いただいた”MiBarcode”等も使用せずに)でcode128のバーコードを作成できればと考えているのですが、斜め上ニュース管理人様の方で作成いただけないでしょうか?また、レクチャーいただけないでしょうか?不躾な質問・要望で申し分けございません。ご容赦ください。

    返信
  16. おパパ

    上記コードを埋め込みマクロを実行したのですが、
    コンパイルエラー:変数が定義されていません。
    というエラーが出てきてしまいます。

    見ると、
    Sub MYBARCODECREATE()
    が黄色くなり、
    msoFalse
    が青くなっています。

    これは何が原因なのでしょうか?

    返信
    1. 斜め上ニュース管理人 投稿作成者

      おパパさんへ
      コードの1行目の「Option Explicit」を削除して実行するとどうなるでしょうか?

      返信
  17. I

    バーコードを3000点2~3分で作成できました。しかし、EXCELに貼り付けると画像が大きすぎるとのメッセージがでて400個くらいしか貼り付けができません。しかし、現在利用しているフリーソフトでは作成に2時間くらいかかります。分割して貼り付けてもこのソフトのほうが大変助かります。ありがとうございました。しかし、実際は7000点近くになることを想定して、バーコードを一括で大量に作成貼り付けのできるソフトがひつようです。アクセスを利用しても同じでしょうか。

    返信
    1. I

      斜め上の管理人様
      EXCEL2007以上のファイル同士であれば2000点でも作成に6~7分、貼り付けて1分でバーコードを作成できました。ありがとうございました。いままでの手間は一体何だったんでしょうか。これで
      なんとか利用できることを確信しました。
      問題点
      1リセットがVBAできないか
      2文字列も貼り付けできないか
      以上2点ができれば非常に良いソフトであると思います。

      返信

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です