| |
念のため印刷を押下した際に実行される最初のコードも記載します。独学で作成したので、読みづらいところも多々あると思いますが、よろしくお願いします。
1つ目のファイルには
ワークシート1には製品の出荷履歴(X軸には納入月、Y軸には製品コード)
ワークシート2以降はオーダー毎の受注明細が記載されています。
2つ目のファイルには
ワークシート1には発注履歴(今回は関係なし)
ワークシート2には主要な製品の在庫表(入出庫履歴)(X軸には納入月、Y軸には製品コード)が記載されています。
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim xlSheet As Worksheet
Dim yer As String
Dim mon As String
Dim item(4) As Object
Dim i As Long
i = 1
Dim objx As Object
Dim objy As Object
Dim WMon As Long
Dim WItem As Long
ActiveSheet.PageSetup.BlackAndWhite = True
'受注明細を記載したシートのタブの色が赤の時のみ実行されるようにしています。
If ActiveSheet.Tab.ColorIndex = 3 Then
'xlSheetには1つ目のファイルの出荷履歴のシートがセットされます。
Set xlSheet = ThisWorkbook.Worksheets("商品マスター")
With ActiveSheet
'yerには受注明細シートに記載されている納入年を、monには納入月が代入されます。それらの変数を使用し、出荷数を記入すべき出荷履歴シートのX軸を検索します。
yer = Year(.Range("B5"))
mon = Month(.Range("B5"))
Set objx = xlSheet.Cells.Find(What:=DateValue(yer & "/" & mon & "/1"), SearchOrder:=xlByRows, LookIn:=xlFormulas)
'itemには製品コードが入ります。受注明細には最大4製品の売上まで1つのシートに記入できるので、item(4)まで有ります。それらの変数を使用し、出荷数を記入すべき出荷履歴シートのY軸を検索します。
Set item(1) = .Range("B9")
Set item(2) = .Range("B14")
Set item(3) = .Range("B19")
Set item(4) = .Range("B24")
Do Until item(i) = ""
Set objy = xlSheet.Cells.Find(What:=item(i), SearchOrder:=xlByColumns)
'検索されたX軸、Y軸の行、列の情報をそれぞれWMonとWItemに代入します。
WMon = objx.Column
WItem = objy.Row
'コメント記入のプロージャーを呼び出します。
Call WComment(xlSheet, WItem, WMon, item(), i)
'2つ目のファイルに記入するプロージャーを呼び出します
Call Standard(mon, item(), i)
i = i + 1
Loop
'受注明細に印刷日時を記入し、タブの色をオレンジに変更します。
.Range("I2") = Date
.Tab.ColorIndex = 7
End With
ThisWorkbook.Activate
End If
End Sub
|
|
くまさん
- 15/10/20(火) 9:35 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
