Excel-VBAによるバーコード生成プログラム-No.3

こんにちは、Ryoです。
今回はNo.2に続き、生成した文字をcode39フォントに置換し画像化する処理を行う
「b.バーコードフォント置換、画像化」について解説していきます。

ちなみに、No.1記事はこちら、No.2記事はここから行けます。

1.Excel画面

セル「B13」に生成された文字、セル「C5」のNumber情報を読み込み、処理後に画像化した
バーコードをセル「C24」位置に貼付けます。

2.コード全体

コード全体は以下の通りです。

Sub bcode_base()

    Dim i As Integer
    Dim barcode As String
    Dim barcode_type As String
    Dim strName(10) As Variant
   
    Application.ScreenUpdating = False

    If Cells(13, 2) = "" Then
        MsgBox "バーコード文字が生成されていません", vbCritical
        Exit Sub
    End If
    
    Call Clear_bc
    
     '//バーコード化する文字列の読み込み//
     barcode = ActiveSheet.Cells(13, 2).Value
     '//PartNumberはバーコード上部に表示する為、格納//
     p_name = ActiveSheet.Cells(5, 3).Value
     '//バーコード化するFontTypeを読み込み（code39)//
     barcode_type = ActiveSheet.Cells(7, 4).Value
         
     Cells(23, 3).Value = "No." & p_name
     Cells(23, 3).ShrinkToFit = True
         
            
    With Cells(24, 3)
          .Value = "*" & barcode & "*"
          '//インストールされたFontNameと合わせること//
          .Font.Name = "c39hrp48dhtt"
          .Font.Size = 42
          .NumberFormat = "@" '入力された値をそのまま表示
          .HorizontalAlignment = xlCenter
          .Select
          .CopyPicture Appearance:=xlScreen, Format:=xlPicture
          .ClearContents
      End With
           
      ActiveSheet.Paste
        
        '//貼り付けたバーコード画像情報を取得//
      For i = 1 To ActiveSheet.Shapes.Count
            strName(i) = ActiveSheet.Shapes(i).Name
            
             If InStr(strName(i), "Picture") = 1 _
             Or InStr(strName(i), "図") = 1 Then
                   '//バーコード画像のTop座標を取得//
                   St = ActiveSheet.Shapes(strName(i)).Top
                   
                    With ActiveSheet.Shapes(strName(i))
                      '//縦横比のロック解除//
                      .LockAspectRatio = False
                      '//Font変換は縦が短い為、画像を引き延ばす//
                      .Height = 55
                      '//引き延ばした画像を既定位置に移動する//
                      .Top = St - 5
                    End With
                    
                 Cells(23, 3).Select
                 '//貼り付けたバーコード画像とNumber,
                    'バーコード文字を併せて画像化する//
                 Range(Cells(23, 3), Cells(24, 3)).CopyPicture _
                 Appearance:=xlScreen, Format:=xlPicture
                 Cells(23, 3).ClearContents
                 ActiveSheet.Shapes(strName(i)).Delete
             End If
        Next i
        
        '//Number、バーコード、文字が含まれた画像を貼り付ける//
        ActiveSheet.Paste
    
    Cells(13, 2).Select
    Application.ScreenUpdating = True

End Sub

では、各コードについて解説していきます。

3.コード解説

ここでは生成した文字列をバーコードフォントに置換し、「Number」に入力された情報と
合わせて画像化する処理を行っています。
上述のコード全体から解説毎に切り分けてる都合上、行番号が不整合になってますが、
ご容赦くださいませ。

最初は処理速度低下と画面チラつき防止を目的として画面を固定化します。

 Application.ScreenUpdating = False

バーコード化する文字情報が対象セルに入力されていなければ警告を表示します。

　If Cells(13, 2) = "" Then
        MsgBox "バーコード文字が生成されていません", vbCritical
        Exit Sub
  End If

既に生成されたバーコード画像有無等を確認し、あればクリアする処理する
プログラムを呼び出して実行します。

 Call Clear_bc

バーコード化する文字情報とバーコード上部に表示する「Number」を読み込みます。
ここでバーコード種類のcode39をbarcode_typeで読み込んでいるのは、今後
code128やNW7等の対応を考えた場合に必要になるだけなので、code39限定なら
記述しなくても問題ありません。

　 barcode = ActiveSheet.Cells(13, 2).Value
  
   p_name = ActiveSheet.Cells(5, 3).Value
  
   barcode_type = ActiveSheet.Cells(7, 4).Value

読み込んだ「Number」に表示上に必要となる文字を連結（ここでは”No.”とします）し、
入力対象セルに対して、使用可能な列幅に収まるように自動的に文字列を縮小する
処理を行います。

 　Cells(23, 3).Value = "No." & p_name
   
   Cells(23, 3).ShrinkToFit = True

ここで読み込んだ文字列をバーコードフォントに置換しますが、記述にあるように
先頭と末尾に”*”を連結した上で置換しなければバーコードとして成立しませんので
注意が必要です。（スタート・ストップキャラクタと言います）

　　　　 With Cells(24, 3)
               .Value = "*" & barcode & "*"

“*”を連結後、冒頭にインストールしたバーコードフォントを指定しますが、
フォントの名前を同一にしないと読み込めませんのでご注意ください。
今回の場合、”c39hrp48dhtt”という名前になっています。

　　　　　　　.Font.Name = "c39hrp48dhtt"

以降の記述はフォントサイズ、フォーマットや表示指定を行い、置換されたバーコードを
図としてコピーし、その後対象セルをクリアします。

　　　　　　　.Font.Size = 42
              .NumberFormat = "@" 
              .HorizontalAlignment = xlCenter
              .Select
              .CopyPicture Appearance:=xlScreen, Format:=xlPicture
              .ClearContents
          End With

先程図としてコピーしたバーコードを貼付けます。

　　　 ActiveSheet.Paste

貼り付けたバーコード画像情報を取得し、Top位置座標を取得します。
理由としては、バーコード上部に表示するNumber情報との位置調整と
形の調整を行う為です。

　　　For i = 1 To ActiveSheet.Shapes.Count
    
　        strName(i) = ActiveSheet.Shapes(i).Name
  
　             If InStr(strName(i), "Picture") = 1 _
               Or InStr(strName(i), "図") = 1 Then
                  
                   St = ActiveSheet.Shapes(strName(i)).Top

座標情報を取得後、画像の縦横比ロック解除を行い高さと位置調整を行います。

　　　　　　　　　With ActiveSheet.Shapes(strName(i))
                    
                    .LockAspectRatio = False
                    
                    .Height = 55
                    
                    .Top = St - 5

                  End With

                  Cells(23, 3).Select

その後、調整したバーコード画像とNumber情報を合わせて図としてコピーし、
不要となった画像を削除します。

　　　　　　　　　Range(Cells(23, 3), Cells(24, 3)).CopyPicture _

                  Appearance:=xlScreen, Format:=xlPicture

                  Cells(23, 3).ClearContents

                  ActiveSheet.Shapes(strName(i)).Delete

             End If

        Next i

最終的に完成した画像を貼付け、画面固定化を戻して処理は終了です。
図としてコピーする処理を複数回実施しているのは、一度バーコード
フォントのみの形調整を行った上で上部に表示するNumberと合わせないと
かなり不格好になるからなので、ここはお好みで良いと思います。




ここまでの処理が「バーコード生成」ボタンに登録した内容ですので、
押すと画像化されて表示されると思います。

以上がバーコードフォントへの置換と画像化処理解説になります。
次回のNo.4では画像化したバーコードのラベル様式反映処理を実施しますので、
宜しくお願いします。

Ryo