こんにちは、Ryoです。
さて、今回はNo.3に続き、code39フォントに置換し画像化した
バーコードをラベル様式に反映する「c.印刷様式への貼付け」と
「d.処理中の画像等クリア」について解説していきます。
ちなみに記事のNo.1はここから、No.2はこちらから、No.3はこの辺りから行けます。
1.Excel画面
【印刷ボタン】を画像の下に設置し、これから作成するコードを登録します。
別Sheetの名前をここでは「ラベル印刷用」として作っています。
セル幅等は以下の通りです。
- 列幅:24.13
- 行の高さ:79.25
- 余白上、下:0.9
- 余白右、左:0.8
- 用紙サイズ:A4
ラベルシールはスリーエムジャパン株式会社(A-one)品番28388 44面 一片サイズ48.3*25.4mm レーザープリンタ用を使用しています。
2.コード全体
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
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), "図") = 1 Then 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
では、各コードについて解説していきます。
3.コード解説
ここでは画像化したバーコードを印刷用ラベルシート様式へ貼付ける処理を行います。
先ず生成された文字情報をクリアして画面を固定化し、バーコード画像の情報
(名前)取得とコピーを行います。
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
ここからラベル様式に合わせた位置に画像の貼付けを行っていきます。
先ずSheet内に残された画像を削除し、初期位置を選択します。
Call Picture_Del Cells(1,1).Select
貼付け位置と画像のリネーム用変数を指定します。
Lは貼り付け位置(Left)の補正用、nmは画像リネーム管理用です。
L = 0 nm = 100
今回使用するラベルは4列×11行となっていますので、位置をシフトしながら
貼付けを行っていきます。
必要回数の繰り返し処理と開始位置に画像を貼付けて、名前情報を取得します。
For e = 1 To 4 '//ラベル4列// For i = 1 To 11 '//ラベル11行// Ct = Ct + 1 ActiveSheet.Paste Bn = Selection.Name
貼付けの処理を行った画像は選択された状態になっていますので、取得した
画像名に対しリネームを行います。
With ActiveSheet.Shapes(Bn) .Name = "Picture" & nm + Ct End With
リネームした画像を改めて指定し印字部に合わせて位置調整を行います
リネーム理由ですが、最初に生成したにバーコード画像を元にして
コピーし貼付けていきますので、画像名が貼付け処理する度に
「同じ名前」となることから処理上変更する必要がある為です。
初期位置に貼付けた画像を.Topと.Leftで位置を指定します。
その後、次の行(この場合+78.8)位置をシフトし11行分繰り返します。
With ActiveSheet.Shapes("Picture" & nm + Ct) .Top = T + 13.5 .Left = L + 13.75 End With T = T + 78.8 Next i
1列分11行の貼付けが完了したら、Top位置を0とし、Left位置をシフト
(この場合+148)し、次行の処理を開始するという繰り返し処理になります。
T = 0 L = L + 148 Next e
貼付け処理完了後、画面固定化解除を行って処理終了となります。
Range("A1").Select Application.ScreenUpdating = True End Sub
ここまでの処理を「印刷ラベル反映」ボタンに登録してありますので、
押すと様式に4×11枚分のバーコード画像が貼り付けられます。
次にクリア処理部分について解説します。
バーコード生成~ラベル様式貼付けまでのコード内で見かける
Call Clear_bcとCall Picture_Delについて簡単にご説明します。
当処理はそれぞれのコード内で実行すれば済むのですが、実行したい箇所で
何度も同じコードを記述するのは手間ですし、修正があると面倒なことに
なりますので、単純動作で完結する処理は分けた方が後々楽になります。
先ずClear_bcの目的は、バーコード生成する際に以前のデータが残っていると
間違いやすいことと紛らわしい為、必要なくなった情報を消しています。
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), "図") = 1 Then ActiveSheet.Shapes(strName(i)).Delete End If Next i Range(Cells(23, 3), Cells(25, 3)).ClearContents Application.ScreenUpdating = True End Sub
次にPicture_Delですが、ラベル様式側に以前生成した画像が残っていると
手動で消去する手間があったり、そのまま実行すると画像に画像が重なって
いきますので、いつしか異常に重いファイルになったりします。
その為、印刷ラベル反映処理実行時に対象シートに存在するpictureファイル
全てを抽出して削除を実行するものです。
この処理を単独で完結しておくと「画像消去」等のボタンを作って登録すれば
手動で全てクリアすることも出来ます。
Sub Picture_Del() Dim Shp As Shape For Each Shp In ActiveSheet.Shapes If Shp.Type = msoPicture Then Shp.Delete Next Shp End Sub
以上になります。
取り扱う製品やバーコード化したい目的によって形や表示は様々なので、
ピンポイントでニーズにマッチするものではないと思いますが、ご検討の
一助や何かのお役に立てれば幸いです。
Ryo