悩んでくれる方募集中！(コード掲載)

質問

いままで売掛一覧シートの「A列」のランダムな位置に数字の[ 1 ]を数カ所入力し、列を選択した場合その「列」に入っているデーターを納品書シートにあてはめて印刷しておりました。（下記コード使用）

-------------------------------------------------------------

Sub 納品書印刷()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = ThisWorkbook.Worksheets("売掛一覧")
Set Sheet2 = ThisWorkbook.Worksheets("納品書")
Dim baseRow As Long

' 4行目から、2列目（日付）が空になるまでループ
baseRow = 4
Do While (Sheet1.Cells(baseRow, 2).Value <> "")

'1列目（A列）に数字の1が入っていた時のみ印刷
If (Sheet1.Cells(baseRow, 1).Value = 1) Then

' P2 に 2列目の値を代入
' O3 に 3列目の値を代入等
Sheet2.Range("P2").Value = Sheet1.Cells(baseRow, 2).Value
Sheet2.Range("O3").Value = Sheet1.Cells(baseRow, 3).Value
Sheet2.Range("O12").Value = Sheet1.Cells(baseRow, 4).Value
Sheet2.Range("W8").Value = Sheet1.Cells(baseRow, 5).Value
Sheet2.Range("W11").Value = Sheet1.Cells(baseRow, 6).Value
Sheet2.Range("B15").Value = Sheet1.Cells(baseRow, 7).Value
Sheet2.Range("Q15").Value = Sheet1.Cells(baseRow, 8).Value
Sheet2.Range("H15").Value = Sheet1.Cells(baseRow, 9).Value
Sheet2.Range("I15").Value = Sheet1.Cells(baseRow, 10).Value
Sheet2.Range("J15").Value = Sheet1.Cells(baseRow, 11).Value

' 印刷プレビュー
Sheet2.PrintPreview
End If

'次の行
baseRow = baseRow + 1
Loop
Set Sheet2 = Nothing
Set Sheet1 = Nothing
End Sub

----------------------------------------------------------------
　ここからが本題なのですが、先ほど数字の1を入れるA列の[ 1 ]の他に数字の[ 2 ]と[ 3 ]も入れたときには下記のようにデーターを移動したいのです。

数字の[ 2 ]を入れた場合は、
Sheet2.Range("B16").Value = Sheet1.Cells(baseRow, 7).Value
Sheet2.Range("Q16").Value = Sheet1.Cells(baseRow, 8).Value
Sheet2.Range("H16").Value = Sheet1.Cells(baseRow, 9).Value
Sheet2.Range("I16").Value = Sheet1.Cells(baseRow, 10).Value
Sheet2.Range("J16").Value = Sheet1.Cells(baseRow, 11).Value

数字の[ 3 ]を入れた場合は、
Sheet2.Range("B17").Value = Sheet1.Cells(baseRow, 7).Value
Sheet2.Range("Q17").Value = Sheet1.Cells(baseRow, 8).Value
Sheet2.Range("H17").Value = Sheet1.Cells(baseRow, 9).Value
Sheet2.Range("I17").Value = Sheet1.Cells(baseRow, 10).Value
Sheet2.Range("J17").Value = Sheet1.Cells(baseRow, 11).Value

上記のよに印刷したいのです。[1]を入力の場合はLoop機能も使用して今まで通り使用して、[ 2 ]と[ 3 ]はLoopさせたくありません。

このようなわがままな件ですが
お付き合いの程よろしくお願いいたします。

回答No.4

fumufumu_2006 · ベストアンサー

>今回のシートにおいてA列に[1][2][3]にて選択してプリントした時、プリントしたという証にB列のセルに紫の色を付けたいのですが可能でしょうか。
>でも、プリントプレビューでは色を付けたくありません。
プレビューから印刷したかどうかを判別する方法がわからない（あるかもしれないけど）ので、印刷済みに設定するか問い合わせる方法で妥協してください。
それと少し修正してます。（A列に空白とかがあった場合の対処）

Sub 納品書印刷()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = ThisWorkbook.Worksheets("売掛一覧")
Set Sheet2 = ThisWorkbook.Worksheets("納品書")
Dim baseRow As Long
Dim baseRowA As Integer 'Sheet1.Cells(baseRow, 1).Valueの値(印刷が必要かのフラグにも使う)
Dim printData As String '印刷済みチェック用

' 4行目から、2列目（日付）が空になるまでループ
baseRow = 4
Do While (Sheet1.Cells(baseRow, 2).Value <> "")

'1列目（A列）に数字の1以上が入っていた時のみ印刷対象
If Val(Sheet1.Cells(baseRow, 1).Value) >= 1 Then

'1列目（A列）が１の場合
If Val(Sheet1.Cells(baseRow, 1).Value) = 1 Then

'それ以前に印刷設定してある分を印刷(ただし最初(baseRowA=0の場合)は除く)
If baseRowA <> 0 Then
' 印刷プレビュー
Sheet2.PrintPreview
If MsgBox("印刷済みにしますか？", vbYesNo) = vbYes Then
'B列の背景を紫に
'printDataから最後のカンマを削除する
Sheet1.Range(Left(printData, Len(printData) - 1)).Interior.ColorIndex = 13
End If
End If

'印刷終わったら次に備えて明細削除(最後にクリアしてないのでbaseRowA=0の時も）
'最大明細行に合わせて3は変更してください
Sheet2.Range("B15").Resize(3, 1).Value = ""
Sheet2.Range("Q15").Resize(3, 1).Value = ""
Sheet2.Range("H15").Resize(3, 1).Value = ""
Sheet2.Range("I15").Resize(3, 1).Value = ""
Sheet2.Range("J15").Resize(3, 1).Value = ""
printData = ""
End If

'baseRowAを定義
baseRowA = Val(Sheet1.Cells(baseRow, 1).Value)

If baseRowA = 1 Then
'質問の仕様に合わせて、この部分はa=1の場合だけ
' P2 に 2列目の値を代入
' O3 に 3列目の値を代入等
Sheet2.Range("P2").Value = Sheet1.Cells(baseRow, 2).Value
Sheet2.Range("O3").Value = Sheet1.Cells(baseRow, 3).Value
Sheet2.Range("O12").Value = Sheet1.Cells(baseRow, 4).Value
Sheet2.Range("W8").Value = Sheet1.Cells(baseRow, 5).Value
Sheet2.Range("W11").Value = Sheet1.Cells(baseRow, 6).Value
End If

'明細部分(baseRowAの値で行を変える)
Sheet2.Range("B15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 7).Value
Sheet2.Range("Q15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 8).Value
Sheet2.Range("H15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 9).Value
Sheet2.Range("I15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 10).Value
Sheet2.Range("J15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 11).Value

'印刷済みチェック用
printData = printData & "B" & baseRow & ","
End If

'次の行
baseRow = baseRow + 1
Loop

'印刷設定してある分を印刷(ただし印刷データが無かった場合(baseRowA=0の場合)は除く)
If baseRowA <> 0 Then
' 印刷プレビュー
Sheet2.PrintPreview
If MsgBox("印刷済みにしますか？", vbYesNo) = vbYes Then
'B列の背景を紫に
'printDataから最後のカンマを削除する
Sheet1.Range(Left(printData, Len(printData) - 1)).Interior.ColorIndex = 13
End If
End If

Set Sheet2 = Nothing
Set Sheet1 = Nothing
End Sub

補足

お時間さいていただき本当に感謝いたします。標準モジュールに入れ、試しました。

　A列に1を連続6個並べたとき、B列が1個おきに紫になってしまいました。（6カ所とも紫になってほしい）

A列に1、2、3とと並べたときも同じでした。

法則は偶数の列だけ色が付きません。

自分なりにいろいろ試しましたがやはり及びませんでした。
おつきあいおねがいいたします。

回答No.5

fumufumu_2006

>法則は偶数の列だけ色が付きません。
こちらでは全て紫になります・・・

A列に1を連続6個並べたとき、6回確認メッセージが出ましたか?
手動でB列の背景を紫にできますか？
色が変わらないセルに条件付書式が設定されていませんか？

を確認してみてください。

お礼

1行置きにセルの書式設定が設定されておりました。
今回までお付き合いありがとうございました。
満足のいく結果につながり感謝いたします。
失礼いたします。

回答No.3

fumufumu_2006

今までは1枚の納品書に1行だけ印刷してたけど、1枚に複数行印刷したいということでしょうか？
違ったら読み飛ばしてください。

Sub 納品書印刷()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = ThisWorkbook.Worksheets("売掛一覧")
Set Sheet2 = ThisWorkbook.Worksheets("納品書")
Dim baseRow As Long
Dim baseRowA As Integer 'Sheet1.Cells(baseRow, 1).Valueの値(印刷が必要かのフラグにも使う)

' 4行目から、2列目（日付）が空になるまでループ
baseRow = 4
Do While (Sheet1.Cells(baseRow, 2).Value <> "")

'1列目（A列）に数字の1以上が入っていた時のみ印刷対象
If Sheet1.Cells(baseRow, 1).Value >= 1 Then

'1列目（A列）が１の場合
If Sheet1.Cells(baseRow, 1).Value = 1 Then

'それ以前に印刷設定してある分を印刷(ただし最初(baseRowA=0の場合)は除く)
If baseRowA <> 0 Then
' 印刷プレビュー
Sheet2.PrintPreview
End If

'印刷終わったら次に備えて明細削除(最後にクリアしてないのでbaseRowA=0の時も）
'最大明細行に合わせて3は変更してください
Sheet2.Range("B15").Resize(3, 1).Value = ""
Sheet2.Range("Q15").Resize(3, 1).Value = ""
Sheet2.Range("H15").Resize(3, 1).Value = ""
Sheet2.Range("I15").Resize(3, 1).Value = ""
Sheet2.Range("J15").Resize(3, 1).Value = ""
End If

'baseRowAを定義
baseRowA = Sheet1.Cells(baseRow, 1).Value

If baseRowA = 1 Then
'質問の仕様に合わせて、この部分はa=1の場合だけ
' P2 に 2列目の値を代入
' O3 に 3列目の値を代入等
Sheet2.Range("P2").Value = Sheet1.Cells(baseRow, 2).Value
Sheet2.Range("O3").Value = Sheet1.Cells(baseRow, 3).Value
Sheet2.Range("O12").Value = Sheet1.Cells(baseRow, 4).Value
Sheet2.Range("W8").Value = Sheet1.Cells(baseRow, 5).Value
Sheet2.Range("W11").Value = Sheet1.Cells(baseRow, 6).Value
End If

'明細部分(baseRowAの値で行を変える)
Sheet2.Range("B15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 7).Value
Sheet2.Range("Q15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 8).Value
Sheet2.Range("H15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 9).Value
Sheet2.Range("I15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 10).Value
Sheet2.Range("J15").Offset(baseRowA - 1, 0).Value = Sheet1.Cells(baseRow, 11).Value

End If

'次の行
baseRow = baseRow + 1
Loop

'印刷設定してある分を印刷(ただし印刷データが無かった場合(baseRowA=0の場合)は除く)
If baseRowA <> 0 Then
' 印刷プレビュー
Sheet2.PrintPreview
End If

Set Sheet2 = Nothing
Set Sheet1 = Nothing
End Sub

p.s.
ANo.2さんの
>それから、何ゆえSheet2はRangeを使っているのでしょうか。
これは多分わかります。
印刷する方のシートは画面を見ながら「えーっと、Qは17、Hは8・・・」と調べるのは面倒だからではないでしょうか？
実は私はそうなってます。
画面の変更がある時変更が楽なので。
本当は名前を定義しておくともっと楽だったりするんですが・・・

補足

ご回答ありがとうございます。バッチリできていて文句の付けようがありませんでした。まさに希望していたものズバリでございます。
ありがとうございます。
　恐縮ですがもう一問お付き合いお願いできないでしょうか。
それは
今回のシートにおいてA列に[1][2][3]にて選択してプリントした時、プリントしたという証にB列のセルに紫の色を付けたいのですが可能でしょうか。
でも、プリントプレビューでは色を付けたくありません。
[1][2][3]によって色を変ず、紫1色で良いです。
よろしくお願いできないでしょうか。

回答No.2

miyuyu

少しわからないところがあるので教えてください。

A列の[1]は、複数存在するのですか？
最後までLoopしているのと「[2][3]はLoopさせたくありません」から
そう思いました。
[2][3]は1件あるか、もしくはない場合もあると考えるのでしょうか。
そうでないと、複数件の[1]に対して、どの[2][3]を適用するのか不明です。
要は、[1]は複数件あるが、[2][3]は1件以下で
印刷するものは、[2][3]は毎回同じ内容であるかです。

それから、何ゆえSheet2はRangeを使っているのでしょうか。
いけなくはありませんが、行が1つ違うだけで列は同じなのですから
Cellsではいけませんか？

補足

お時間さいていただきありがとう御座います。

A列の[1]は、複数存在するのですか？の問いですがはい。複数です。
[2][3]は1件あるか、もしくはない場合もあると考えるのでしょうか。
の問いですがその通りです。[2][3]がない場合もあります。そして
ある選択した[1]に対して[2][3]と連続させて選択してプリントしたいのです。
[1]を複数選択した場合は今まで通りLoopにて連続プリントプレビューしてましたが、[1][2][3]と連続させてプリントプレビューさせる場合はLoopなしで単ページとして印刷させるつもりです。

[2][3]は毎回同じ内容ではありません。

それから、何ゆえSheet2はRangeを使っているのでしょうか。
それは・・・以前ご教授いただいたコードなのです。

売掛一覧より納品書に印刷する内容は例えば
パソコン　一式　　50000円　の場合は[1]を入れ、1行でプリント。
（この一式の場合が多数ある。）

まれに、別件で
モニター　2台　26000円　計52000円　[1]をいれ、
コード　　1式　　　　　計3000円　　[2]をいれ、
キーボード3台　12000円　計36000円　[3]をいれる
といった具合に個別に3行用紙1枚にプリントしたいのです。

わかりにくく申し訳ありません。
おつきあいよろしくお願いいたします。

回答No.1

suz83238

Doの下に
If Sheet1.Cells(baseRow, 1).Value = 2 Then
Sheet2.Range("B16").Value = Sheet1.Cells(baseRow, 7).Value
Sheet2.Range("Q16").Value = Sheet1.Cells(baseRow, 8).Value
Sheet2.Range("H16").Value = Sheet1.Cells(baseRow, 9).Value
Sheet2.Range("I16").Value = Sheet1.Cells(baseRow, 10).Value
Sheet2.Range("J16").Value = Sheet1.Cells(baseRow, 11).Value
end if
If Sheet1.Cells(baseRow, 1).Value = 3 Then
Sheet2.Range("B17").Value = Sheet1.Cells(baseRow, 7).Value
Sheet2.Range("Q17").Value = Sheet1.Cells(baseRow, 8).Value
Sheet2.Range("H17").Value = Sheet1.Cells(baseRow, 9).Value
Sheet2.Range("I17").Value = Sheet1.Cells(baseRow, 10).Value
Sheet2.Range("J17").Value = Sheet1.Cells(baseRow, 11).Value
end if

だけど、全体的にもう少しスマートにならないですかね？

補足

ご回答ありがとうございます。
うまくいくのですが、次の印刷に移るときに前印刷のデーターが残ったままになるのですがどのようにするとよろしいでしょうか。
例1回目印刷
[1]で選択の1行目のデータ「ああああ」
[2]で選択の2行目のデータ「いいいい」
[3]で選択の3行目のデータ「うううう」

2回目の印刷
[1]で選択の1行目のデータ「かかかか」これだけ印刷したいのですが
前回選択の2行目のデータ「いいいい」
前回選択の3行目のデータ「うううう」
と、売掛一覧の[2][3]の数字をDeleteボタンにてクリアしても前回の2、3行目もプリントされてしまいます。
わかる方には簡単なことかもしれませんがよろしくお願いいたします。