excel 空白セルに自動で斜線をひきたいです

EXCEL２００７使用しています。

名簿シートと印刷シートがあります。
印刷シートのセルAJ３３：AR３７の結合セルに=IF(VLOOKUP($J$4,名簿!$A$2:$G$383,7)="","","印")
がはいっています。

このセルが空白ならば斜線を引きたいのですが、なかなかうまくできません。
過去の質問等も参考にしましたが、斜線は引けても、今度は消えません・・・。

ちなみに連続印刷をすでに作ってあるのですが、この連続印刷にも対応させることは可能でしょうか？

Ａ１：Ｃ３の結合セルの名前は”番号”　
印刷範囲の入力セルは”自”、”至”としてあります。

Sub 印刷開始()
Range("番号") = Range("自")
Do While Range("番号") <= Range("至")
Sheets("印刷").PrintOut
Range("番号") = Range("番号") + 1
Loop
End Sub


説明力がなくて申し訳ないのですが、どうぞよろしくお願い致します。

No.1 回答者： tom04 回答日時： 2014/09/11 16:35

こんにちは！

＞このセルが空白ならば斜線を引きたいのですが、なかなかうまくできません。

詳しく検証していませんが・・・

Sub 印刷開始()
Range("番号") = Range("自")
Do While Range("番号") <= Range("至")
With Range("AJ33")
If .Value = "" Then
.Borders(xlDiagonalUp).LineStyle = xlContinuous
Else
.Borders(xlDiagonalUp).LineStyle = xlNone
End If
End With
Sheets("印刷").PrintOut
Range("番号") = Range("番号") + 1
Loop
End Sub

こんな感じをご希望なのでしょうか？m(_ _)m

この回答へのお礼

お礼が遅くなってしまいすいません。

希望通りの動きを再現でき、とても勉強になりました。

ありがとうございました。

お礼日時：2014/09/16 15:02

No.2 ベストアンサー 回答者： eden3616 回答日時： 2014/09/11 16:59

すでにNo1さんが回答されてはいますが、

J14セルの数式で、名簿に番号が無かった場合のエラー対策を一応入れています。

あと、（おそらく）印刷範囲外の行数分（10行）だけ、ご質問内容と画像の状態がずれています。
どちらに合わせて作成するか判断しかねますので、統一性を持たせてください。

>印刷シートのセルAJ３３：AR３７の結合セルに
画像ではAJ43:AR47と見受けられます。

>=IF(VLOOKUP($J$4,名簿!$A$2:$G$383,7)="","","印")
個の数式で参照している「$J$4」は画像では「$J$14」ですよね？

下記コードは画像の状態として作成しています。
「AJ33」に「"印"」や「""」が表示されるのであれば
『Set myRng = Range("AJ43")』を変更してください。

■注意
印刷開始マクロに斜線の切換コードを追加したコードが「VBAコード(1)」になります。
既存の印刷開始マクロと差し換えて利用してください。

ただし、

名前「番号」の範囲A1：C3の手入力時にも斜線を切り替えたい場合は
印刷するシート名を右クリック→コードの表示
最下の「VBAコード(2)」を貼り付けたうえで、
現在の印刷開始マクロはそのまま『変更せずに』利用してください。


■VBAコード(1)

Sub 印刷開始()
Dim myRng As Range
Set myRng = Range("AJ43")
Range("番号") = Range("自")
Do While Range("番号") <= Range("至")
　　If IsError(myRng.Value) Then Exit Sub
　　With myRng.Borders(xlDiagonalDown)
　　　　If myRng.Value = "" Then
　　　　　　.LineStyle = xlContinuous
　　　　Else
　　　　　　.LineStyle = xlNone
　　　　End If
　　End With
　　Sheets("印刷").PrintOut
　　Range("番号") = Range("番号") + 1
Loop
End Sub


■VBAコード(2)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRng As Range
Set myRng = Range("AJ43")
　　If IsError(myRng.Value) Then Exit Sub
　　With myRng.Borders(xlDiagonalDown)
　　　　If myRng.Value = "" Then
　　　　　　.LineStyle = xlContinuous
　　　　Else
　　　　　　.LineStyle = xlNone
　　　　End If
　　End With
End Sub

この回答へのお礼

お礼が遅くなってすいません。
そして、質問と画像の行数のズレ、ご指摘通りです…今後気をつけたいと思います。
ありがとうございます。

本題ですが、今回はコード(２)の方を使用させて頂きました。
名前「番号」の範囲A1：C3に手入力し、画面上で情報を確認することがありますので、非常に助かりました。

本当にありがとうございました

お礼日時：2014/09/16 14:57

No.3 回答者： eden3616 回答日時： 2014/09/11 17:08

No2のものです。

申し訳ありません。

数式エラーの場合コードを終了していましたので
印刷が途中で停止してしまいます。
『VBAコード(1)』を修正致します。


■VBAコード(1)

Sub 印刷開始()
Dim myRng As Range
Set myRng = Range("AJ43")
Range("番号") = Range("自")
Do While Range("番号") <= Range("至")
　　With myRng.Borders(xlDiagonalDown)
　　　　If IsError(myRng.Value) Then
　　　　　　.LineStyle = xlContinuous
　　　　Else
　　　　　　If myRng.Value = "" Then
　　　　　　　　.LineStyle = xlContinuous
　　　　　　Else
　　　　　　　　.LineStyle = xlNone
　　　　　　End If
　　　　End If
　　End With
　　Sheets("印刷").PrintOut
　　Range("番号") = Range("番号") + 1
Loop
End Sub