Execl2007のVBAの質問です

質問

度々申し訳ありませんが、何卒またお教えください。
下記の様なコードを書いたのですが、
オートフィルタの解除ができません。
何故なんでしょうか？

ちなみに、ある任意の日付の行だけを抽出して
別のシートにコピー・プリントアウト
を自動化するマクロを作りたいと思っています。

他にもコードに問題などありましたら
指摘いただけると幸いです。
よろしくお願いします。

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

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

回答No.4

Wendy02 · ベストアンサー

こんにちは。

私個人としては、どうもバグのようなものだと解釈していました。
（軽率にバグだというと、恥をかくこともありますが。）

>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

お礼

ありがとうございます！
とても勉強になります。

'ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
はマクロの自動記録で出てきたコードをそのまま流用
しただけで、正直意味は全く分かっていません。

それにしても全然違ったコードになっていたので
びっくりしました。
本来はやはりシートやリストも宣言してから
使うべきなのですね。
見たことがない関数？も出ているので
じっくり勉強したいと思います。

回答No.3

Wendy02

こんばんは。

私は、どうも甘く見ていました。下位バージョンと同じだと思っていました。だから、単に、フィルターの部分をすべて出せばよいと思っていましたが、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

お礼

重ね重ねありがとうございます。
フィルターの解除はうまくいきました！
でも何故か
.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
　　　　Worksheets("貼り付け用紙").Range("A1")
の行が機能しません。

元データーの「見出しの行？」は貼り付けられているので、
コピーペーストはうまくいってるみたいです。
抽出もできています。
ですので抽出したセルのセレクトができていない
ということでしょうか。。。

ちょっとCurrentRegion.SpecialCells(xlCellTypeVisible)
を勉強してきます。

またここでご報告致します。

補足

やっと分かりました！
CurrentRegionはアクティブセル領域を意味して
いるので、データの途中で空白があると
そこから下は選択されなかったみたいです。

これで自作初のマクロが完成しそうです。
この度は本当にありがとうございました。

回答No.2

Wendy02

こんばんは。

>コピーした後の貼り付けもできてませんでした。
この程度で、全部書く必要がないと思ったので、単に一部しか書いていません。

もし、厳密に言うなら、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

お礼

すみません。説明不足でした。
>コピーした後の貼り付けもできてませんでした。
というのは、マクロを実行したとき、コピーペーストの
メソッドがうまく機能しなかった。という意味です。

書いて頂いたコードを実行してみましたが、
やはりオートフィルタの解除はできていません。。。。
それ以外は問題ありません。

元データの方に問題がないか等、
もう一度見直してみます。

回答No.1

Wendy02

こんにちは。

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 すればよいと思います。

お礼

早速の回答ありがとうございます。

試してみましたが、やはりうまくいきません。。。
しかもよくみると
コピーした後の貼り付けもできてませんでした。

うまくいくときといかない時がある気がしますが、
何か関係があるのでしょうか？