CODE128(コードセットCのみ)をエクセルだけで作る方法

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

CODE128のコードセットCのバーコードをエクセルだけで作る方法を紹介します。

CODE128(コード128)のコードセットCのバーコードは、数字のみを表示するのに使われます。
数字のみの長い値を表現するのに適しています。

なお、今回の記事を活用する際、下記仕様1点は注意してください。
■バーコードを作る対象の値が奇数桁の場合、先頭に「0」を付加します。

下記のような表に一括でバーコード画像を作成します。


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

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

「挿入」をクリック

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

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

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

Function IndexNumber(Target1, Target2)
    Dim i As Integer
    For i = 0 To UBound(Target1)
        If Target1(i) = Target2 Then Exit For
    Next
    IndexNumber = i
End Function
Sub CODE128_C()
    Application.ScreenUpdating = False
    Dim textcode, mynumberC As Variant
    Dim mycode, myc As String
    Dim c As Range
    Dim i, a, q, x, y, m, f As Integer
    Dim t As Double
    Dim shbar, sh As Worksheet
    textcode = Array(212222, 222122, 222221, 121223, 121322, 131222, 122213, 122312, 132212, _
                     221213, 221312, 231212, 112232, 122132, 122231, 113222, 123122, 123221, _
                     223211, 221132, 221231, 213212, 223112, 312131, 311222, 321122, 321221, _
                     312212, 322112, 322211, 212123, 212321, 232121, 111323, 131123, 131321, _
                     112313, 132113, 132311, 211313, 231113, 231311, 112133, 112331, 132131, _
                     113123, 113321, 133121, 313121, 211331, 231131, 213113, 213311, 213131, _
                     311123, 311321, 331121, 312113, 312311, 332111, 314111, 221411, 431111, _
                     111224, 111422, 121124, 121421, 141122, 141221, 112214, 112412, 122114, _
                     122411, 142112, 142211, 241211, 221114, 413111, 241112, 134111, 111242, _
                     121142, 121241, 114212, 124112, 124211, 411212, 421112, 421211, 212141, _
                     214121, 412121, 111143, 111341, 131141, 114113, 114311, 411113, 411311, _
                     113141, 114131, 311141, 411131)
    mynumberC = Array("00", "01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12", "13", "14", _
                      "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", _
                      "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", _
                      "45", "46", "47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", _
                      "60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", _
                      "75", "76", "77", "78", "79", "80", "81", "82", "83", "84", "85", "86", "87", "88", "89", _
                      "90", "91", "92", "93", "94", "95", "96", "97", "98", "99", "CODE B", "CODE A", "FNC 1")
    Set sh = ActiveSheet
    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 = 8
    Cells.Font.Size = 6
    sh.Activate
    f = 0
    For Each c In Selection
        Select Case Len(c) Mod 2
            Case 1
                myc = "0" & c.Text
                mycode = "9211232"
                    For i = 1 To Len(myc) Step 2
                        mycode = mycode & textcode(IndexNumber(mynumberC, StrConv(Mid(myc, i, 2), vbNarrow)))
                    Next
                t = 105
                    For a = 1 To Len(myc) / 2
                        t = t + a * IndexNumber(mynumberC, CStr(Mid(myc, Application.WorksheetFunction.RoundUp(a * 2 - 1, 0), 2)))
                    Next
                mycode = mycode & textcode(t Mod 103)
                mycode = mycode & "23311129"
                f = 1
            Case 0
                mycode = "9211232"
                For i = 1 To Len(c) Step 2
                    mycode = mycode & textcode(IndexNumber(mynumberC, StrConv(Mid(c, i, 2), vbNarrow)))
                Next
                t = 105
                For a = 1 To Len(c) / 2
                    t = t + a * IndexNumber(mynumberC, CStr(Mid(c, Application.WorksheetFunction.RoundUp(a * 2 - 1, 0), 2)))
                Next
                mycode = mycode & textcode(t Mod 103)
                mycode = mycode & "23311129"
        End Select
        shbar.Activate
        m = 1
        For q = 1 To Len(mycode)
            Select Case q Mod 2
                Case 1
                    For y = 1 To CInt(Mid(mycode, q, 1))
                        m = m + 1
                    Next
                Case 0
                    For y = 1 To CInt(Mid(mycode, q, 1))
                        Cells(2, m).Interior.Color = 0
                        m = m + 1
                    Next
            End Select
        Next
        With Range(Cells(3, 1), Cells(3, m))
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .ShrinkToFit = True
        End With
        Range("A3").NumberFormatLocal = "@"
        Select Case f
            Case 1
                Range("A3").Value = myc
            Case 0
                Range("A3").Value = c.Value
        End Select
        shbar.Range(Cells(2, 1), Cells(3, m)).CopyPicture Appearance:=xlScreen, Format:=xlPicture
        sh.Activate
        c.Offset(0, 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
        shbar.Cells.UnMerge
        f = 0
    Next c
        Application.DisplayAlerts = False
            shbar.Delete
        Application.DisplayAlerts = True
End Sub

今貼り付けたプログラムを実行する
バーコードを作りたいデータの入ったセルを選択し、「開発タブ」の「マクロ」を選択します。
(選択したセル分のみを処理します)
開発タブが表示されて無い場合は開発タブを表示する方法を参考にしてください。

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

ここまでの手順をこなすと、CODE128のコードセットCのバーコードができると思います。

一応CODE128のコードセットCのバーコードを作れるようにできたと思いますが、私はプログラムに関しては素人です。
当ブログの記事を用いることによって被った損害・損失に対しては一切の責任を負いかねますのであらかじめご了承下さい。

シェア頂けると嬉しいです!よろしくお願いします!
URLをコピーする
URLをコピーしました!
  • URLをコピーしました!

コメント

コメントする

目次
閉じる