Execl2007のVBAの質問です

Question

度々申し訳ありませんが、何卒またお教えください。
下記の様なコードを書いたのですが、
オートフィルタの解除ができません。
何故なんでしょうか？

ちなみに、ある任意の日付の行だけを抽出して
別のシートにコピー・プリントアウト
を自動化するマクロを作りたいと思っています。

他にもコードに問題などありましたら
指摘いただけると幸いです。
よろしくお願いします。

----------------------------------------------------------------

Sub macro2()
'macro test 2
  
  Dim yyyymmdd As Date
  yyyymmdd = InputBox("印刷したい日付を入力して下さい。", "印刷日入力")
  
     With Worksheets("結果")
      .ListObjects("リスト1").Range.AutoFilter Field:=1, Criteria1:=yyyymmdd
      .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
            Worksheets("貼り付け用紙").Range("A1")
      
     End With
      
    'ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
    Worksheets("結果").AutoFilterMode = False
    Application.CutCopyMode = False
    Worksheets("貼り付け用紙").Range("A1:AM100").ClearContents
    
    
    
End Sub

Wendy02 · Accepted Answer

こんにちは。

私個人としては、どうもバグのようなものだと解釈していました。
（軽率にバグだというと、恥をかくこともありますが。）

>CurrentRegionはアクティブセル領域を意味しているので、データの途中で空白があるとそこから下は選択されなかったみたいです。

CurrentRegionというのは、日本語で「地続き」というのにふさわしいです。ハスでも、繋がっていれば、範囲を選択します。しかし、こちらで、もう一度、考え直してみましたが、ListObject のRange プロパティから取得したほうが良いのではないかと思います。

本格的に書き直してみました。

'変更箇所
　Set rng = objList.Range.SpecialCells(xlCellTypeVisible)
　rng.Copy Sh2.Range("A1")
　
それと、
'ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
これは、正しいですか?　きちんとヘルプなりで調べられればよいのですが、今は日本語ヘルプはありませんから、分からないと思います。

ヘルプより
PRINT(印刷範囲, 開始, 終了, 部数, 簡易印刷, プレビュー, 印刷範囲, カラー印刷, 給紙方法, 印刷品質, 縦方向の解像度, 印刷対象)

分からない場合は、VBAコマンドにしたほうがよいです。
以下は、丸々使う必要はありませんが、参考にしてみてください。

'-------------------------------------------

Sub ListForOutput1()
　　'macro test 2
　　Dim myDate As Variant 'バリアント型
　　Dim fmt As String
　　Dim objList As ListObject
　　Dim rng As Range
　　Dim Sh1 As Worksheet
　　Dim Sh2 As Worksheet
　　
'-------------------
　　Set Sh1 = Worksheets("結果")
　　Set Sh2 = Worksheets("貼り付け用紙")
'--------------------
　　Sh2.Range("A1:AM100").ClearContents
　　Do
　　　　myDate = Application.InputBox("印刷したい日付を入力して下さい。", "印刷日入力", Type:=2)
　　　　If VarType(myDate) = vbBoolean Then Exit Sub
　　　　'日付のチェック
　　　　If IsDate(myDate) = False Then MsgBox myDate & "　は、日付ではありません。"
　　Loop Until IsDate(myDate)
　　
　　With Sh1
　　　　Set objList = .ListObjects("リスト1")
　　　　fmt = .Range("A2").NumberFormatLocal '書式を取る
　　　　myDate = Format(myDate, fmt) '入力文字の書式変更

　　　　objList.Range.AutoFilter Field:=1, Criteria1:=myDate
　　　　Set rng = objList.Range.SpecialCells(xlCellTypeVisible)
　　　　rng.Copy Sh2.Range("A1")
　　　　
　　　　objList.Range.AutoFilter Field:=1
　　End With
　　Application.CutCopyMode = False
　　With Sh2
　　 .Select
'印刷
　　 .PageSetup.PrintArea = .Range("A1").CurrentRegion.Address
　　 .PrintOut Preview:=True　'False にすると印刷します
　　End With
　　Set rng = Nothing
　　Set objList = Nothing
　　Set Sh1 = Nothing
　　Set Sh2 = Nothing
End Sub

Wendy02 · Answer

こんにちは。

With Worksheets("結果")
.ListObjects("リスト1").Range.AutoFilter Field:=1, Criteria1:=yyyymmdd
.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
　Worksheets("貼り付け用紙").Range("A1")
　.ListObjects("リスト1").Range.Select '←ここ
　.AutoFilterMode = False
End With

このように、一旦、Select すればよいと思います。

Wendy02 · Answer

こんばんは。

>コピーした後の貼り付けもできてませんでした。
この程度で、全部書く必要がないと思ったので、単に一部しか書いていません。

もし、厳密に言うなら、AutoFilter のオン・オフを利用するなら、AutoFilter そのものを使えばよいのでは？わざわざ、ListObject を使うというのは、そこに数式の自動コピーなどがあるということだと思いますが、マクロからの違いは、あまりありません。

これで出来ていないということでしょうか？
'-------------------------------------------
Sub macro2R()
　　'macro test 2
　　Dim yyyymmdd As Date
　　yyyymmdd = InputBox("印刷したい日付を入力して下さい。", "印刷日入力")
　　With Worksheets("結果")
　　　　.ListObjects("リスト1").Range.AutoFilter Field:=1, Criteria1:=yyyymmdd
　　　　.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
　　　　Worksheets("貼り付け用紙").Range("A1")
　　　　.ListObjects("リスト1").Range.Select
　　　　.AutoFilterMode = False
　　End With
　　'印刷？
　　'ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
　　Application.CutCopyMode = False
　　Worksheets("貼り付け用紙").Select
　　MsgBox "確認", vbInformation
　　Worksheets("貼り付け用紙").Range("A1:AM100").ClearContents
End Sub

Wendy02 · Answer

こんばんは。

私は、どうも甘く見ていました。下位バージョンと同じだと思っていました。だから、単に、フィルターの部分をすべて出せばよいと思っていましたが、Excel 2007 の場合は、その範囲がテーブルになっていますから、違いがあるようです。（間違いなく、この部分は安定していません。2007のみのようです。次バージョンで、またここは変わるかもしれません。）まあ、マクロにするなら、オートフィルタのほうが安定して使えると思います。私は、新しいテーブルオブジェクトの経験はほとんどありません。

>>コピーした後の貼り付けもできてませんでした。
>というのは、マクロを実行したとき、コピーペーストの
>メソッドがうまく機能しなかった。という意味です。

もともと、VBAから、Date 型の検索文字を、ファルタで検索すること自体に問題はないか、バージョンやローカル仕様の違いがあって、うまくいくか同じコードでも可能か分かりません。

>他にもコードに問題などありましたら
>指摘いただけると幸いです

後で見直ししましたが、基本的な流れ自体に、間違いはないでしょうか。エラーは出ていないでしょうか？コードによって、何度か不明なエラーが発生しました。

本来の目的は、もしかしたら、フィルタで選択したものをコピーして、それを印刷するというマクロではありませんか？そうしたら、質問のコード自体が違いますね。

>　　'ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
Ver.4 マクロ関数で印刷が良いか悪いかは別として、わざわざこういうコードを使うというのは、出来れば、ヘルプもマニュアルもある人が使うほうが無難です。（Excel 2007 までです。）

2007でためしてみて、一応、コピー&ペースは成功しています。フィルターも解除されています。しかし、下位バージョンではうまく行かない可能性もあります。以下で一度試してみてください。
'-------------------------------------------
Sub macro3R()
　　'macro test 2
　　Dim yyyymmdd As Variant '←念のためバリアント型に変えた

　　Worksheets("貼り付け用紙").Range("A1:AM100").ClearContents

　　yyyymmdd = InputBox("印刷したい日付を入力して下さい。", "印刷日入力")
　　With Worksheets("結果")
　　　　.ListObjects("リスト1").Range.AutoFilter Field:=1, Criteria1:=yyyymmdd
　　　　.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
　　　　Worksheets("貼り付け用紙").Range("A1")
　　　　.ListObjects("リスト1").Range.AutoFilter Field:=1
　　End With
　　Application.CutCopyMode = False
　　Worksheets("貼り付け用紙").Select
　　'印刷
　　'ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"

End Sub

Execl2007のVBAの質問です

こんにちは。

こんばんは。

こんばんは。

この回答への補足

こんにちは。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング