[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『セルにバーコードを連続生成したい』（ナナ）
いつもお世話になっております。
数千件～数万件のデータをvbaのバーコードコントロールを使って連続でデータをバーコード化したいと考えています。
ワークシートsheet2のセルA列のA1から各行に１１桁の数値のデータが入力されています。データは平均1万件あります。
この状態で、バーコードコントロール使ってsheet1にデータの件数分転記してバーコードを連続生成して印刷したいです。
バーコードがA4サイズの紙に収まるようにA～F列の6列×10行で、A4用紙一枚あたり60個（セル幅21.0 高さ57.75のセル内に収まるように）生成しようと考えているのですが、一万件のデータがあるため、流れ的に
A１、B1、C1、D1、E1、F1、A2、B2、C2、D2、E2、F2…
と、A1から横にバーコードを生成してF列まできたらA列に戻るというループ作業のマクロを作成したいのですが、私には難しすぎてお手上げ状態です。
ちなみにバーコードの種類はcode-128です。
お手数ですがご教示いただけますと幸いです。
後、一万件のバーコードを生成するので、処理に耐え切れるかも心配なので、良い案があればアドバイスください。
よろしくお願いします。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
検索すると こんなのがヒットしました
そのまんまだと思います
https://jizilog.com/vba-bcodectrlop
（渡辺ひかる） 2019/09/20(金) 12:17
VBAを使用しなくともバーコードフォントを利用してみてはいかがでしょう？ 「バーコードフォント」で検索するといろいろでてきますよ。 （ろっくん） 2019/09/20(金) 12:25
＞ろっくん様
返信ありがとうございます。
職場のPCを使用するのですが、バーコードフォントが使えない環境のため、バーコードコントロールを使うしかない状態です。
（ナナ） 2019/09/20(金) 12:43
＞自力でアレンジできません。
そういうことですか、ではバーコードの質問ではなくてループ方法の質問ですね
下記のコードは、Sheet2のデータを、Sheet1に6列に転記するコードです この処理の部分を バーコードにすればいいと思います。
Sub test3()
Dim i As Long
Dim j As Long
For i = 1 To 1700
For j = 1 To 6
Worksheets("Sheet1").Cells(i, j).Value = _
Worksheets("Sheet2").Cells((i - 1) * 6 + j, 1).Value
Next
Next
End Sub
（渡辺ひかる） 2019/09/20(金) 13:21
厳密に言うとバーコードコントロールを使用した際のループ処理がわかりません。
セルのループ処理についてはCells(x, y)だとすればy変数を変化させれば横に移動するループ処理
だと理解しているのですが、バーコードコントロールを使用した際のコードを見ても内容が複雑で、どのコードをどう改変すればいいかわからない状態です。
さきほどリンクに張っていただいたサイトのサンプルコードをどう改良すればいいでしょうか。
無知のため質問ばかりで申し訳ありません。
Sub B_Code_Ctrl_Sample()
Dim Str_Code As Variant Dim Start_Add, Col As String Dim Row_Pos, Col_Num, LastRow, Count As Long Dim BC_Data() As String Dim i As Integer
'**バーコード化するCodeデータ読み込み**
For Each Str_Code In Range("A:A")
If Str_Code = "Code" Then
Row_Pos = Str_Code.Row
Start_Add = Str_Code.Address(True, False)
Col = Left(Start_Add, InStr(Start_Add, "$") - 1)
Col_Num = Asc(Col) - 64 '列番号アルファベットを数値化
LastRow = Cells(Rows.Count, Col_Num).End(xlUp).Row 'データ入力最終行
Count = LastRow - Row_Pos 'データ数
End If
Next
ReDim BC_Data(1 To Count) As String
'バーコードへのリンクセル設定用にデータ入力セルのアドレスを取得
For i = 1 To Count
BC_Data(i) = Cells(Row_Pos + i, Col_Num).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Next i
'**バーコード貼付けセルのサイズ指定処理**
'このサイズ設定はバーコード化する内容により適宜調整
Rows(Row_Pos + 1 & ":" & LastRow).RowHeight = 70
Columns(Col_Num + 1).ColumnWidth = 30
'**バーコードコントロールプロパティ設定**
'プロパティについては以下URLのMSDN参照
'https://msdn.microsoft.com/ja-jp/library/cc427149.aspx
Const BC_Style As Integer = 7
'スタイル
'0: UPC-A, 1: UPC-E, 2: JAN-13, 3: JAN-8, 4: Casecode, 5: NW-7,
'6: Code-39, 7: Code-128, 8: U.S. Postnet, 9: U.S. Postal FIM, 10: 郵便物の表示用途（日本）
Const BC_Substyle As Integer = 0
'サブスタイル (下記URL参照)
'https://msdn.microsoft.com/ja-jp/library/cc427156.aspx
Const BC_Validation As Integer = 1
'データの確認
'0: 確認無し, 1: 無効なら計算を補正, 2: 無効なら非表示
'Code39/NW-7の場合、「1」でスタート/ストップ文字(*)を自動的に追加
Const BC_LineWeight As Integer = 3
'線の太さ
'0: 極細線, 1:細線, 2:中細線, 3:標準, 4:中太線, 5: 太線, 6:極太線, 7:超極太線
Const BC_Direction As Integer = 0
'バーコードの表示方向
'0: 0度, 1: 90度, 2: 180度, 3: 270度 [0]が標準
Const BC_ShowData As Integer = 1
'データの表示
'0: 表示無し, 1:表示有り
Const BC_ForeColor As Long = rgbBlack
'前景色の指定
Const BC_BackColor As Long = rgbWhite
'背景色の指定
'rgbBlackなどの色定数は以下URLのMSDN参照
'https://msdn.microsoft.com/ja-jp/VBA/Excel-VBA/articles/xlrgbcolor-enumeration-excel
'**バーコード化の処理＊＊
Dim BC_OLE_Obj As OLEObject
Dim BC_Obj As BARCODELib.BarCodeCtrl
For i = 1 To Count
'バーコードサイズ、及び貼り付ける位置の指定
'上で設定したセルサイズに対し、枠内中央とする為にTop/Leftは+5、Height/Widthは-10
With Cells(i + Row_Pos, Col_Num + 1)
ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1", Link:=False, DisplayAsIcon:=False, _
Top:=.Top + 5, Left:=.Left + 5, Height:=.Height - 10, Width:=.Width - 10).Select
End With
Set BC_OLE_Obj = Selection
Set BC_Obj = BC_OLE_Obj.Object
'バーコードにプロパティ設定
With BC_Obj
.Style = BC_Style
.SubStyle = BC_Substyle
.Validation = BC_Validation
.LineWeight = BC_LineWeight
.Direction = BC_Direction
.ShowData = BC_ShowData
.ForeColor = BC_ForeColor
.BackColor = BC_BackColor
.Refresh
End With
'リンクするセルアドレスを指定
With BC_OLE_Obj
.Visible = False
.LinkedCell = Range(BC_Data(i)).Address(RowAbsolute:=False, ColumnAbsolute:=False, _
ReferenceStyle:=Application.ReferenceStyle)
.Visible = True
End With
Next i
End Sub
（ナナ） 2019/09/20(金) 13:42
Sub test()
Dim R As Range
Dim i As Long
For i = ActiveSheet.OLEObjects.Count To 1 Step -1
ActiveSheet.OLEObjects(i).Delete
Next i
For i = 1 To 10
Set R = Cells((i - 1) \ 5 + 1, (i - 1) Mod 5 + 1)
With ActiveSheet.OLEObjects.Add(classtype:="BARCODE.BarcodeCtrl")
.Top = R.Top
.Left = R.Left
.Width = R.Width
.Height = R.Height
.LinkedCell = R.Address
.Visible = True
End With
Next i
End Sub
（???） 2019/09/20(金) 14:06
返信ありがとうございます。
いまいちバーコードコントロールのコードが理解できていないところが申し訳ないのですが
以下のようにコードを変えてみたところバーコードは生成されませんでした。
Sub B_Code_Ctrl_Sample()
Dim Str_Code As Variant Dim Start_Add, Col As String Dim Row_Pos, Col_Num, LastRow, Count As Long Dim BC_Data() As String Dim i As Integer
'**バーコード化するCodeデータ読み込み**
For Each Str_Code In Range("A:A")
If Str_Code = "Code" Then
Row_Pos = Str_Code.Row
Start_Add = Str_Code.Address(True, False)
Col = Left(Start_Add, InStr(Start_Add, "$") - 1)
Col_Num = Asc(Col) - 64 '列番号アルファベットを数値化
LastRow = Cells(Rows.Count, Col_Num).End(xlUp).Row 'データ入力最終行
Count = LastRow - Row_Pos 'データ数
End If
Next
ReDim BC_Data(1 To Count) As String
'バーコードへのリンクセル設定用にデータ入力セルのアドレスを取得
For i = 1 To Count
BC_Data(i) = Cells(Row_Pos + i, Col_Num).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Next i
'**バーコード貼付けセルのサイズ指定処理**
'このサイズ設定はバーコード化する内容により適宜調整
Rows(Row_Pos + 1 & ":" & LastRow).RowHeight = 70
Columns(Col_Num + 1).ColumnWidth = 30
'**バーコードコントロールプロパティ設定**
'プロパティについては以下URLのMSDN参照
'https://msdn.microsoft.com/ja-jp/library/cc427149.aspx
Const BC_Style As Integer = 7
'スタイル
'0: UPC-A, 1: UPC-E, 2: JAN-13, 3: JAN-8, 4: Casecode, 5: NW-7,
'6: Code-39, 7: Code-128, 8: U.S. Postnet, 9: U.S. Postal FIM, 10: 郵便物の表示用途（日本）
Const BC_Substyle As Integer = 0
'サブスタイル (下記URL参照)
'https://msdn.microsoft.com/ja-jp/library/cc427156.aspx
Const BC_Validation As Integer = 1
'データの確認
'0: 確認無し, 1: 無効なら計算を補正, 2: 無効なら非表示
'Code39/NW-7の場合、「1」でスタート/ストップ文字(*)を自動的に追加
Const BC_LineWeight As Integer = 3
'線の太さ
'0: 極細線, 1:細線, 2:中細線, 3:標準, 4:中太線, 5: 太線, 6:極太線, 7:超極太線
Const BC_Direction As Integer = 0
'バーコードの表示方向
'0: 0度, 1: 90度, 2: 180度, 3: 270度 [0]が標準
Const BC_ShowData As Integer = 1
'データの表示
'0: 表示無し, 1:表示有り
Const BC_ForeColor As Long = rgbBlack
'前景色の指定
Const BC_BackColor As Long = rgbWhite
'背景色の指定
'rgbBlackなどの色定数は以下URLのMSDN参照
'https://msdn.microsoft.com/ja-jp/VBA/Excel-VBA/articles/xlrgbcolor-enumeration-excel
'**バーコード化の処理＊＊
Dim BC_OLE_Obj As OLEObject
Dim BC_Obj As BARCODELib.BarCodeCtrl
For i = ActiveSheet.OLEObjects.Count To 1 Step -1
ActiveSheet.OLEObjects(i).Delete
Next i
For i = 1 To 10
Set R = Cells((i - 1) \ 5 + 1, (i - 1) Mod 5 + 1)
With ActiveSheet.OLEObjects.Add(classtype:="BARCODE.BarcodeCtrl")
.Top = R.Top
.Left = R.Left
.Width = R.Width
.Height = R.Height
.LinkedCell = R.Address
.Visible = True
End With
Next i
End Sub
（ナナ） 2019/09/20(金) 14:33
2010の頃はバーコードの色指定プロパティが無かったのですが、2016にはあるようなので、色指定しないと真っ白になっているのかも？ 「ホーム」－「検索と選択」－「オブジェクトの選択と表示」で、表示/非表示を切り替えてみてください。（セルいっぱいにサイズ指定していたので、貼れていれば、セルの文字を覆い隠していたはず）
なお、バーコードコントロールはAccessのおまけであり、Excelでどんな動作をするかは保証されていないと思います。 自分で試行錯誤して解決できないなら、使っては駄目ですよ。
（???） 2019/09/20(金) 15:53
Sub test4()
Dim i As Long
Dim j As Long
Dim r As Range
With Worksheets("Sheet1")
For i = .Shapes.Count To 1 Step -1
.Shapes(i).Delete
Next i
End With
For i = 1 To 2 '1700
For j = 1 To 6
Set r = Worksheets("Sheet1").Cells(i, j)
With Worksheets("Sheet1").OLEObjects.Add(classtype:="BARCODE.BarCodeCtrl")
.Top = r.Top + 5
.Left = r.Left + 5
.Height = r.Height - 10
.Width = r.Width - 10
With .Object
.Style = 7
.SubStyle = 0
.Value = Worksheets("Sheet2").Cells((i - 1) * 6 + j, 1).Value
End With
End With
Next j
Next i
End Sub
（渡辺ひかる） 2019/09/20(金) 16:34
またわからないことがあれば質問させてもらいます。
どうもありがとうございました。
（ナナ） 2019/09/20(金) 19:53
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.