Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


63030 / 76732 ←次へ | 前へ→

【18301】Re:行数が不定の集計処理について
回答  Kein  - 04/9/21(火) 2:13 -

引用なし
パスワード
   コードの意味ですが

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

というように変更して下さい。
1 hits

【18165】行数が不定の集計処理について ackkn 04/9/16(木) 21:15 質問
【18166】Re:行数が不定の集計処理について Kein 04/9/16(木) 22:08 回答
【18167】Re:行数が不定の集計処理について ackkn 04/9/16(木) 22:49 お礼
【18168】Re:行数が不定の集計処理について ackkn 04/9/16(木) 23:04 質問
【18171】Re:行数が不定の集計処理について Kein 04/9/17(金) 1:46 発言
【18189】Re:行数が不定の集計処理について ackkn 04/9/17(金) 17:08 発言
【18207】Re:行数が不定の集計処理について Kein 04/9/18(土) 0:31 回答
【18208】Re:行数が不定の集計処理について Kein 04/9/18(土) 0:34 発言
【18213】Re:行数が不定の集計処理について ackkn 04/9/18(土) 11:47 回答
【18217】Re:行数が不定の集計処理について ackkn 04/9/18(土) 14:02 回答
【18223】Re:行数が不定の集計処理について Kein 04/9/18(土) 18:25 回答
【18224】Re:行数が不定の集計処理について Kein 04/9/18(土) 18:32 発言
【18249】Re:行数が不定の集計処理について ackkn 04/9/19(日) 14:41 回答
【18256】Re:行数が不定の集計処理について Kein 04/9/19(日) 20:11 回答
【18257】Re:行数が不定の集計処理について ackkn 04/9/19(日) 23:22 回答
【18259】Re:行数が不定の集計処理について Kein 04/9/20(月) 0:56 回答
【18263】Re:行数が不定の集計処理について ackkn 04/9/20(月) 6:38 お礼
【18289】Re:行数が不定の集計処理について ackkn 04/9/20(月) 17:58 質問
【18293】Re:行数が不定の集計処理について Kein 04/9/20(月) 22:18 回答
【18299】Re:行数が不定の集計処理について ackkn 04/9/20(月) 23:42 質問
【18301】Re:行数が不定の集計処理について Kein 04/9/21(火) 2:13 回答

63030 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free