こんにちは、Ryoです。
先日の記事「バーコードコントロールを使用し生成する」の中でも触れているラベルシートなどへの反映についてですが、もう１パターンとして「生成したバーコード」を1枚ずつラベルシートに順次貼付け、ラベルシートがFullになったら印刷→クリア→残分を貼付けていくサンプルコードを参考までに紹介したいと思います。
1.サンプル概要
◆前提条件
バーコードコントロールを使用した生成については、以前の記事をご参照ください。
本サンプルはバーコード生成済みの状態からラベルシートへの反映を行いますが、ラベル印刷用のシートはエーワン ラベルシール レーザー A4 44面 20シート 28388に合わせています。
（11行×4列の計44枚用）
Worksheetのセルサイズ設定などについては過去記事の以下を参照いただければと思います。
◆動作概要
バーコードコントロールを使って生成済みのSheetから処理を実行します。
貼り付けられたバーコードは現時点でOLEObjectなので、For～Eachで検索・抽出して順次図としてコピーし「ラベル印刷用」シートに貼り付けていきます。
生成済みバーコードをラベルシートに1枚ずつ貼り付けていきます。
ラベルシートのSheet名称は「ラベル印刷用」としてサンプルコードを書いています。
2.サンプルコード
Sub Sample1()
Dim BC_Shape As Object
Dim bk_Name As Worksheet
Dim R, C As Long
Dim Num_Cnt As Integer
Application.ScreenUpdating = False
Set bk_Name = ActiveSheet
R = 1 'ラベル印刷SheetのRowカウント用
C = 1 'ラベル印刷SheetのColumnカウント用
For Each BC_Shape In ActiveSheet.OLEObjects
'貼付けが44回＝ラベル様式Fullなので印刷
If Num_Cnt = 44 Then
MsgBox "印刷を実行します"
With Sheets("ラベル印刷用")
.PrintOut
.Activate
End With
'印刷後に様式クリア＆カウントリセット
Call All_Delete
Num_Cnt = 1
bk_Name.Activate
R = 1
C = 1
End If
'OLEObjectのみ処理を行う
If InStr(TypeName(BC_Shape), "OLEObject") = 1 Then
Num_Cnt = Num_Cnt + 1
BC_Shape.CopyPicture
Application.Goto Sheets("ラベル印刷用").Cells(R, C)
ActiveSheet.Paste
'ここで貼り付けたセルに対し画像の位置調整
With Selection
.Top = .Top + 11
.Left = .Left + 4
End With
bk_Name.Activate
R = R + 1
'Rのカウント数で次列以降を判断
Select Case R
Case Is > 11
C = C + 1
R = 1
End Select
End If
Next BC_Shape
Application.ScreenUpdating = True
End Sub
For～Eachでアクティブシート上に存在する“OLEObject”（＝生成したバーコード画像）に対して処理を行います。
ラベル用シートには順次貼り付けていきますが、44枚用を使用していますのでカウント数が44であれば印刷実行、ラベルシートアクティブにして画像クリアを行い、カウントを初期値に戻してからバーコード生成画面に戻す（アクティブ）処理を最初に実行しています。
次のIf InStr(TypeName(BC_Shape), “OLEObject”) = 1 Thenの部分は、改めてOLEObjectであることを確認しなくても良いとは思いましたが、後々条件を変えたい場合に使えることもあって一応入れています。
後は処理回数の加算（Num_Cnt)、選択中のオブジェクトを「図としてコピー」し「ラベル印刷用」シートへジャンプ（ Application.Goto）して貼付け～位置調整を実行します。
貼付け後は行送りカウント（R)に加算して、バーコード生成画面に戻す処理を行い、Rが11を超えていたら次の列に移行させる為の数値をセットして、次のオブジェクトに・・・という繰り返し処理になります。
◆コード内のCall All_Deleteについて
これも以前の記事と同様になりますが、「ラベル印刷用」に貼り付けた画像を印刷後に削除する目的で使いますので、一例として名称がButton以外全削除としています。
Sub All_Delete()
Dim BC_Pic As Shape
For Each BC_Pic In ActiveSheet.Shapes
If InStr(BC_Pic.Name, "Button") <> 1 Then BC_Pic.Delete
Next
End Sub
3.まとめ
本サンプルは単純に「図としてコピー」→「印刷用シート選択」→「指定セルに貼付け」→「位置調整」→「元のシート選択」→「図として・・・の繰り返しです。
Sheet切り替えが煩雑なこともあって、処理時間として「やや長い」ので機会があれば別の手段も考えてみようと思っています。
バーコードを生成後に印刷する上ではラベルシートなどにコピーしていく必要がありますが、この辺りの処理は用途などで様々な形があると思いますので、今回書いているサンプルは私自身の備忘録的な要素が強いです。
以上、生成したバーコードをラベルシートに反映する方法についてでした！
今回の記事が何かの参考になれば幸いです。
Ryo
