はじめに

任意バーコードをエクセルシートに書き出しを行う

プロシジャーの説明

ActiveX コントロール機能を使います。VBAにてActiveXのMicrosoft BarCode Contorol 16.0を操作します。定数宣言でマジックナンバー対応にも対応しました。

サンプル１

Option Explicit
    Dim barcodeCtrl As OLEObject
    Dim targetCell As Range
    Dim leftPos As Double
    Dim topPos As Double
    Dim BacodeData As String
    Dim x, y, i, l, m, Startrow, Endrow As Long
    
    ' 列挙型 定数宣言 ※マジックナンバー対応
    Enum バーコード列
        データ = 4
        線表示      ' 連番機能で勝手に5
    End Enum
    
    ' Const 定数宣言 ※マジックナンバー対応
    Const コード種類 = 7
    Const テキスト表示有り = 1
    Const ヘッダーの段 = 1


Sub GenerateBarcodeAtCell7777()
    ' 初期化
    Call FuncDeleteObjectsInColumn
    
    Endrow = Cells(Rows.Count, バーコード列.データ).End(xlUp).Row
    Startrow = ヘッダーの段 + 1
    
    For i = Startrow To Endrow
        BacodeData = Cells(i, バーコード列.データ).Value
        Set targetCell = ActiveSheet.Cells(i, バーコード列.線表示)
        Call FuncBacodesakusei
    Next
    
End Sub

Function FuncBacodesakusei()
    ' セルの左端と上端の位置を取得
    leftPos = targetCell.Left
    topPos = targetCell.Top
    ' シート上にActiveXコントロールを追加（指定した位置に配置）
    Set barcodeCtrl = ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1", _
                                                 Link:=False, _
                                                 DisplayAsIcon:=False)
    ' コントロールの位置とサイズをセルに合わせて調整
    With barcodeCtrl
        .Left = leftPos
        .Top = topPos
        .Width = targetCell.Width
        .Height = targetCell.Height
    End With
    ' コントロールのプロパティを設定
    With barcodeCtrl.Object
        .Style = コード種類
        .ShowData = テキスト表示有り
        .Value = BacodeData  ' バーコードの値を設定
    End With
End Function

Function FuncDeleteObjectsInColumn()
    Dim obj As Shape
    Dim targetColumn As Integer
    Dim ws As Worksheet
    
    ' 対象のワークシートを指定（ここではアクティブなシート）
    Set ws = ActiveSheet
    
    ' 対象の列を指定
    targetColumn = バーコード列.線表示
    
    ' シート内の全てのオブジェクトをループ
    For Each obj In ws.Shapes
        ' オブジェクトの左位置が列内にある場合に削除
        If obj.Left >= ws.Columns(targetColumn).Left And _
           obj.Left < ws.Columns(targetColumn + 1).Left Then
            obj.Delete
        End If
    Next obj
End Function