| |
オートフィルタを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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
