Excel VBA質問箱 IV

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

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


13730 / 76732 ←次へ | 前へ→

【68505】オートフィルタをONしたままにするとエラー発生
質問  ちゃぷ  - 11/3/11(金) 12:16 -

引用なし
パスワード
   オートフィルタをON(下記1)して、検索して指定の番号を入力すると指定番号が
入った行の情報を新規ファイルにコピペし、新規ファイルを閉じます(下記2)。
その後、オートフィルタをONにしたままのファイルを閉じようとすると
「実行エラー1004:worksheetクラスのAutoFilterModeプロパティを設定
できません」と表示されます。
ファイルを閉じる際にはオートフィルタがON状態の場合、OFFにするように
設定(下記3)しているのですが。
どこを修正すれば良いか教えて頂けると助かります。


Private Sub オートフィルタ切替_Click()
ActiveSheet.Unprotect
Rows("4:4").AutoFilter
ActiveSheet.Protect DrawingObjects:=True, Contents:=False, Scenarios:=True
End Sub


Private Sub タグ作成_Click()
Dim InPt As Long
Dim c As Object
Dim myKey As String
  Dim SaveName As String
  Dim wb As Workbook, wkbk As Workbook
  Set wb = ThisWorkbook
  InPt = Application.InputBox(prompt:="No.をクリックして下さい。", Type:=1)
  If InPt = False Then Exit Sub
ActiveSheet.Unprotect
myKey = InPt
With ActiveSheet.Range("$c$5:$c$3000")
Set c = .Find(What:=myKey, LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByColumns, MatchByte:=False)
If c Is Nothing Then
MsgBox "No." & InPt & "は登録されていません。"
Else
  Sheets("タグ").Activate
  With wb.ActiveSheet
    .Range("c3").Value = InPt
    .Range("B2:C20").Copy
  End With
Application.EnableEvents = False
  Set wkbk = Workbooks.Add
  With wkbk.ActiveSheet
    .Range("B2").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Range("B2").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Columns("A:A").ColumnWidth = 0.5
    .Columns("B:B").ColumnWidth = 10
    .Columns("C:C").ColumnWidth = 50
    .Columns("d:d").ColumnWidth = 0.5
    .Rows("1:1").RowHeight = 5
    .Rows("21:21").RowHeight = 5
    .Columns("E:IV").EntireColumn.Hidden = True
    .Rows("22:65536").EntireRow.Hidden = True
    End With
    With ActiveWindow
    .DisplayGridlines = False
    .DisplayHeadings = False
    .DisplayOutline = False
    .DisplayZeros = False
    .DisplayHorizontalScrollBar = False
    .DisplayVerticalScrollBar = False
    .DisplayWorkbookTabs = True
  End With
  SaveName = ThisWorkbook.Path & "\" & InPt & "タグ.xls"
  Application.DisplayAlerts = False
  ActiveSheet.Range("c3").Locked = True
  ActiveSheet.Protect password:="1234"
  ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
  ActiveWorkbook.SaveAs Filename:=SaveName, FileFormat:=xlNormal, password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
  wkbk.Close False
  Sheets("タグ").Activate
  ThisWorkbook.ActiveSheet.Range("c3").ClearContents
  Sheets("台帳").Activate
  MsgBox "タグ作成しました。"
  Set wb = Nothing
  Set wkbk = Nothing
  Application.EnableEvents = True
End If
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lnglCnt As Long
For lnglCnt = 1 To Application.CommandBars.Count
Application.CommandBars(lnglCnt).Enabled = True
Next lnglCnt
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = True
Sheets("台帳").Activate
If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False
End If
With Application
  Range("D5:D3000").Value = .Asc(.Trim(.Clean(Range("D5:D3000"))))
End With
ActiveSheet.Protect password:="1234"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Protect password:="1234", Structure:=True, Windows:=False
If Me.Saved = False Then Me.Save
End Sub
0 hits

【68505】オートフィルタをONしたままにするとエラー発生 ちゃぷ 11/3/11(金) 12:16 質問
【68511】Re:オートフィルタをONしたままにするとエ... Jaka 11/3/11(金) 16:57 発言
【68526】Re:オートフィルタをONしたままにするとエ... ちゃぷ 11/3/15(火) 15:08 お礼
【68529】Re:オートフィルタをONしたままにするとエ... ちーぱっく 11/3/17(木) 6:44 発言
【68536】Re:オートフィルタをONしたままにするとエ... ちゃぷ 11/3/19(土) 0:37 お礼

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