コードの解説（Excelでバーコード_3）

Excelでバーコード表示に挑戦する連載の3回目です。前回の記事はコチラです。

hirocom777.hatenadiary.org

前回はコード39のバーコードを作成、表示するツールについてご紹介しました。

興味のある方はダウンロードして試してみてください。

drive.google.com

今回は、このツールのコードの解説です。コードは基本的にシートモジュールに記述されています。

入力更新時のコード

まずはシートの入力変更時の処理です。

'入力変更時の処理をします
Private Sub Worksheet_Change(ByVal Target As Range)
  Select Case Target.Address
  Case Me.Range("TEXT").Address, Me.Range("TEXT_BLOCK").Address, Me.Range("FONT").Address
  Case Me.Range("HEIGHT").Address
    '高さ指定なしの場合は100とします
    If Me.Range("HEIGHT").Value = "" Then
      Me.Range("HEIGHT").Value = 100
      Exit Sub
    End If
  Case Me.Range("NARROW").Address
    'ナローバー幅指定なしの場合0.2とします
    If Me.Range("NARROW").Value = "" Then
      Me.Range("NARROW").Value = 0.2
      Exit Sub
    End If
  Case Else
    Exit Sub
  End Select
  If Not MakeCode39(Me.Range("TEXT").Text) And Me.Range("TEXT").Text <> "" Then
    MsgBox "バーコード作成できませんでした"
  End If
End Sub

画面で操作するセルには名前が付いています。バーコードにする文字（TEXT,TEXT_BLOCK）や文字のフォントサイズ（FONT）が変更になった場合はバーコードを再描画します。再描画は下にご紹介するファンクションプロシージャMakeCode39にて実行します。また、バーコードの高さ（HEIGHT）やバーのナロー幅（狭いバーの幅、NARROW）の幅が変更されて値が未指定になった場合はデフォルト値に変更されます。

コード39のバーコード作成

つづいてコード39のバーコード作成部分をご紹介します。

'コード39のバーコードを作成します
Public Function MakeCode39(ByVal textData As String) As Boolean
Dim barData As String
Dim i As Long, j As Long
  '22文字以上はバーコード作成できません。
  '入力がない場合は表示をクリアします。
   ClearBarCode
  If 22 < Len(textData) Or textData = "" Then
    If 22 < Len(textData) Then MsgBox "22文字以下にしてください"
    Exit Function
  End If
  '「*」はバーコードに使用できません
  If 0 < InStr(textData, "*") Then
    MsgBox "「*」は使えません"
    Exit Function
  End If
  Application.ScreenUpdating = False
  '表示サイズを調整します。
  If Me.Range("FONT") <> "" Then Me.Range("CHR_1", "CHR_24").Font.Size = Me.Range("FONT").Value
  Me.Range("TEXT_HEIGHT").RowHeight = Me.Range("FONT").Value
  Me.Range("BAR_HEIGHT").RowHeight = Me.Range("HEIGHT").Value
  Me.Range("TEXT").Font.Size = Me.Range("HEIGHT").Value
  Me.Range("MARGIN").RowHeight = Me.Range("HEIGHT").Value / 10
  Me.Range("QUIET_ZONE").ColumnWidth = Me.Range("NARROW").Value * 15
  '入力を半角大文字にして*を前後につけます。
  textData = "*" & StrConv(textData, vbUpperCase + vbNarrow) & "*"
  '表示するバーをすべて細く設定します。
  Me.Range("BAR_1_1", "BAR_24_10").ColumnWidth = Me.Range("NARROW").Value
  If Len(textData) < 24 Then Me.Range("BAR_" & (Len(textData) + 1) & "_1", "BAR_24_10").Columns.Hidden = True
  For i = 1 To Len(textData)
    Me.Range("CHR_" & i) = Mid$(textData, i, 1)
    barData = GetBarCodePattern(Me.Range("CHR_" & i))
    'バーコード表示できない文字がある場合はバーコード表示をクリアします。
    If barData = "Error" Then
      MsgBox "バーコード表示できません"
      ClearBarCode
      Exit Function
    End If
    '太いバーの表示幅を広げます。
    For j = 1 To 9
      If Mid$(barData, j, 1) = "1" Then Me.Range("BAR_" & i & "_" & j).ColumnWidth = Me.Range("NARROW") * 2.5
    Next j
  Next i
  Application.ScreenUpdating = True
  'ビットマップデータをクリップボードにコピーします。
 If Me.Range("CLIP_BOARD") = "する" Then Me.Range("BAR_CODE").CopyPicture , xlBitmap
  MakeCode39 = True
End Function

バーコード化できる文字数は22文字までです。（スタート（ストップ）キャラクターを含めて24文字になります。）また「*」はスタート（ストップ）キャラクターとして使うのでバーコード本体には指定できません。バーコードを構成するセルにも名前が付いています。バーコード下の文字表記（CHR_1~CHR_24）と文字表記全体の高さ（TEXT_HEIGHT）、バーの高さ（BAR_HEIGHT）、バーコード上下のマージン（MARGIN）、バーコード前後のクワイエットゾーン（QUIET_ZONE）を入力内容を基に設定します。

1文字を構成するバーの数は文字間の間隔も含めて10本になります。24文字分のバーはBAR_1_1~BAR_24_10と名前が付いていて、あらかじめ白黒に着色されています。これらバーの太さを入力された文字にしたがって調整します。実際の変換は次にご紹介するファンクションプロシージャGetBarCodePatternで実施します。

コードの変換

文字からコードへの変換を実行するファンクションプロシージャです。引数で渡された文字を0と1で構成される8文字の文字列で返します。8文字中3文字が1（太いバー）、残りが0（細いバー）になります。このリストは長くなりますので途中は省略します。

'キャラクターからバーコードパターンを返します。
'"0"-細線  "1"-太線
Private Function GetBarCodePattern(ByVal textData As String) As String
  Select Case textData
    Case "0": GetBarCodePattern = "000110100"
    Case "1": GetBarCodePattern = "100100001"
    Case "2": GetBarCodePattern = "001100001"
                      ・
                      ・
                      ・
    Case "/": GetBarCodePattern = "010100010"
    Case "+": GetBarCodePattern = "010001010"
    Case "%": GetBarCodePattern = "000101010"
    Case "*": GetBarCodePattern = "010010100"
    Case Else 'エラー
      GetBarCodePattern = "Error"
  End Select
End Function