PR

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

これで楽に！？VBA活用
2017.07.13
記事内に広告が含まれています。

こんにちは、Ryoです。
今回Excel-VBAでバーコードフォント(code39)を使った生成プログラムを作成しましたので、
ご紹介と解説をしていきたいと思います。
VBA命令文等の詳細な解説は今回割愛しますが、記事内のコードをそのまま使ってもらえれば
普通に動作すると思いますので、ご参考にしていただければ幸いです。

今後、普段よく使用するVBAコマンド等は追々ご紹介と解説の投稿していこうと思います。

スポンサーリンク

1.概要

簡単な様式ですが「code」「Number」「Type」に入力された情報と日付データを統合して
バーコード用文字列を生成し、その文字をバーコードフォントで置換、画像化します。
画像化する理由は印刷様式に位置調整して貼り付ける記述が楽だからですね。
「バーコード種類」欄は今回code39のみで製作していますので、表示用みたいなものです。

上の入力画面で表示しきれていないのですが、バーコード生成後に印刷用ラベルに
合わせた様式へ貼付ける形にしています。

概要としては以上になりますので、これから解説していきたいと思います。

2.使用環境と準備事項

  • OS：Windows7,Windows10は動作確認済みです。
  • Excel ：Office2010で作成しています。
  • Excel Sheet：「バーコード出力」と「ラベル印刷用」の２Sheet
  • 印刷ラベル：スリーエムジャパン株式会社（A-one)品番28388　44面　一片サイズ48.3*25.4mm　レーザープリンタ用
  • Font :Fonts2Uさんの「C39HrP48DhTt フォント」を今回使用します。

フォントのダウンロードはこちらになります。

 

では、先ずバーコードフォントのインストールについてご説明します。

リンク先で①「C39HrP48DhTt フォント」の②ダウンロードをクリックして、
③の保存を実施してください。

その後、保存先を確認するとzipファイルで「c39hr」というフォルダがありますので、
展開（解凍）してからフォルダ内にある①フォントファイル「c39hrp48dhtt」をPCの
②「コントロールパネル」⇒「フォント」内へドラッグすればインストールされます。

フォントのインストールが完了すれば準備完了です。

3.VBAコード構成

コードとしては以下のa～dの構成になっています。
今回のNo.1では全体の概要をざっとご紹介して、No.2以降の記事から各々解説します。

  1. バーコード文字生成
  2. バーコードフォント置換、画像化
  3. 印刷様式への貼付け
  4. 処理中の画像等クリア

a.バーコード文字生成パート

Sub Character_generation()

   Dim Bcode, CompType As String
   Dim Code As Variant
   Dim D As Long
   Dim rng As Range

   Range(Cells(13, 2), Cells(13, 4)).ClearContents
   Set rng = Range("B5:D5")
   
   If WorksheetFunction.CountA(rng) < 3 Then
      MsgBox "バーコード生成に必要な情報が入力されていません", vbCritical
      Exit Sub
    End If
   
   '//文字生成時に入力されている欄をクリアにする//
   Call Clear_bc
   code = Cells(5, 2)
　 '//Typeの頭文字を抜き取る//
   CompType = Mid(Cells(5, 4), 1, 1)
   D = Format(Cells(8, 4), "yyyymd")
   
   '//各々読み込んだデータを連結//
   Bcode = CompType & code & D
   '//連結した文字列を指定セルに表示する//
   Cells(13, 2) = Bcode

End Sub

ここではバーコード化したい文字を読み込み連結する処理を行っています。
今回はExcel表内のTypeの頭文字とcode、日付データをバーコード文字、Numberを
バーコード上部に表示させる情報としています。

 

b.バーコードフォント置換、画像化

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

ここでは生成した文字列をバーコードフォントに置換し、「Number」に入力された情報と
合わせて画像化する処理を行っています。
画像化する目的はバーコードフォント置換後のバランス調整とNumber文字との合成です。

 

c.印刷様式への貼付けパート

Sub Label_print()
'//画像化したバーコードを印刷用ラベルシートへ反映する//
    Dim strName(50) As Variant
    Dim Bn As Variant
    Dim Ct,b,e,nm As Integer
    Dim T,L As Double
 
    Range(Cells(13, 2), Cells(13, 4)).ClearContents
    Application.ScreenUpdating = False
    Ct = 0

    '//バーコード生成画面で作成した画像情報の取得とコピー実行//
    For b = 1 To ActiveSheet.Shapes.Count
          strName(b) = ActiveSheet.Shapes(b).Name
             If InStr(strName(b), "Picture") = 1 _
             Or InStr(strName(b), "図") = 1 Then
                  ActiveSheet.Shapes(strName(b)).Copy
                  Bn = strName(b)
                  Ct = Ct + 1
             End If
    Next b
    
    If Ct <> 1 Then
        MsgBox "バーコード画像が生成されていません", vbCritical
        Exit Sub
    End If
    
    Call Clear_bc
    Application.ScreenUpdating = False
   
    Erase strName
    Worksheets("ラベル印刷用").Activate
    
    '//初期に残データや画像をすべて除去する//
    Call Picture_Del
    Range("A1").Select
  
    L = 0  '//貼り付け位置（Left）補正用//
    nm = 100  '//貼り付け画像のリネーム管理用//
  
    For e = 1 To 4 '//ラベル4列//
        For i = 1 To 11  '//ラベル11行//
           Ct = Ct + 1
           ActiveSheet.Paste
           Bn = Selection.Name
             '//貼り付けた画像はSelect状態にあり、画像名を取得//
             With ActiveSheet.Shapes(Bn)
               '//取得した画像名をReNameする（Copy画像は全てName同一の為)//
               .Name = "Picture" & nm + Ct
             End With
              '//ReNameした画像を指定する//
              With ActiveSheet.Shapes("Picture" & nm + Ct)
               '//貼り付け位置をラベル印字部に合わせてシフトする//
               .Top = T + 13.5
               .Left = L + 13.75
              End With
            T = T + 78.8
          Next i
      '//Topは列完了後に初期位置に戻る//
      T = 0
      L = L + 148
    Next e
 
  Cells(1,1).select
  Application.ScreenUpdating = True
    
End Sub

ここでは画像化したバーコードを印刷用ラベルシート様式へ貼付ける処理を行います。
画像を初期位置（セルA1）に貼り、コピーしながら移動して規定位置に貼付けする
処理としています。

d.処理中の画像クリア等

◆バーコード生成用シートの旧データや画像クリア

Sub Clear_bc()
'//バーコード生成実行時の画面クリア用//

  Dim strName(10) As Variant

  Application.ScreenUpdating = False

     For i = 1 To ActiveSheet.Shapes.Count
            strName(i) = ActiveSheet.Shapes(i).Name
               If InStr(strName(i), "Picture") = 1 _
               Or InStr(strName(i), "図") = 1Then
                  ActiveSheet.Shapes(strName(i)).Delete
               End If
      Next i
    
    Range(Cells(23, 3), Cells(25, 3)).ClearContents
    Application.ScreenUpdating = True

End Sub

◆ラベル様式側の旧画像クリア

Sub Picture_Del()
'//ActiveSheet内のPicture画像をすべて削除する//
  Dim Shp As Shape
  
  For Each Shp In ActiveSheet.Shapes
    If Shp.Type = msoPicture Then Shp.Delete
  Next Shp
  
End Sub

これらは一連の処理実行中に不要となるデータや画像を削除する為のものです。




以上がフォントを用いたVBAコード全体になります。
最初は本記事で全て解説まで書こうと思っていましたが、かなり長くなりそうなので
4記事に分けて書いていきますので、宜しくお願いします。

Ryo

スポンサーリンク
タイトルとURLをコピーしました