| |
コードの意味ですが
Sub R_Hidden_Change()
If ActiveCell.Row <> 3 Then Exit Sub
'もしアクティブセル(ダブルクリックしたセル)の行が 3 以外なら中止
'On Error Resume Next
'これから下でエラーが出たら、それをスキップする
If Hck = False Then
'モジュールレベル変数の値が False なら
If WorksheetFunction.CountA(Range("B4:B65536")) = 0 Then
'もし B4以下のセルに値が入力されていなかったら
MsgBox "B列に値がありません", 48: Exit Sub
'メッセージを出して中止
End If
Range("B4", Range("B65536").End(xlUp)) _
.SpecialCells(4).EntireRow.Hidden = True
'B4〜入力最終行までで、空白セル(SpecialCells(4))の行範囲を非表示に
'する。SpecialCellsメソッドは該当するセルが見つからないとエラーに
'なり、それを事前に検知・回避することが出来ないので、先に On Error 〜
'を入れておいた。
Hck = True
'変数の値を True に変更
Else
'変数の値が True なら
Cells.EntireRow.Hidden = False
'セル全体の行範囲を表示する
Hck = False
'変数の値を False に変える
End If
End Sub
ということになっています。
>集計行含めたエリア
は、例えば B列を基準に最終行を判定し、F列までが表の範囲とするなら
Range("B1", Range("B65536").End(xlUp)).Offset(, -1).Resize(, 5)
になります。ですからここのアドレスを PrintArea プロパティの値に渡してやれば
良さそうなんですが、ちょっとこちらでテストしてみましたが、イマイチうまく
印刷範囲を決定できませんでした。なので印刷時には、それ専用のマクロも入れて
おく、ということで確実な処理をさせるようにします。印刷専用マクロは
Sub MySheet_Print()
Dim PArea As Range
Dim Sh As Worksheet
Dim Ans As Integer
If Hck = False Then Exit Sub
Set PArea = Range("B1", Range("B65536").End(xlUp)) _
.Offset(, -1).Resize(, 5).SpecialCells(12)
On Error Resume Next
Set Sh = Worksheets("MyPrint")
If Err.Number > 0 Then
Set Sh = Worksheets _
.Add(After:=Worksheets(Worksheets.Count)).Name = "MyPrint"
Err.Clear
End If
Sh.Activete: Cells.Clear
PArea.Copy Sh.Range("A1")
Set PArea = Nothing: Set Sh = Nothing
Ans = MsgBox("印刷を開始しますか", 36)
If Ans = 6 Then ActiveSheet.PrintOut Copies:=1
End Sub
というコードでよいでしょう。
あと、この印刷マクロを実行するのに、いちいち「ツール」「マクロ」・・を選択
するのが面倒なら、ダブルクリックイベントで呼び出すマクロで、ダブルクリックした
セルのアドレスを判定し
" A3 セルなら行の表示・非表示切り替え、E3 セルなら印刷マクロを呼び出す"
という形に改造しておくと良いと思います。その場合は R_Hidden_Change を
Sub R_Hidden_Change()
Select Case ActiveCell.Address
Case "$A$3"
GoTo RoLine
Case "$E$3"
Call MySheet_Print
End Select
Exit Sub
RoLine:
On Error Resume Next
If Hck = False Then
If WorksheetFunction.CountA(Range("B4:B65536")) = 0 Then
MsgBox "B列に値がありません", 48: Exit Sub
End If
Range("B4", Range("B65536").End(xlUp)) _
.SpecialCells(4).EntireRow.Hidden = True
Hck = True
Else
Cells.EntireRow.Hidden = False
Hck = False
End If
End Sub
というように変更して下さい。
|
|
Kein
- 04/9/21(火) 2:13 -
