Excelの非表示シートをVBAで削除する【実務で活用できる】

For Each sh In .Worksheets '非表示シートを削除
    If sh.Visible = xlSheetHidden Then
　　    Select Case sh.Name '除外シートを確認
           Case jyogai(0), jyogai(1), jyogai(2)
           Case Else: sh.Delete: n = n + 1 '削除
       End Select
    End If
Next For

'フォルダ内ファイルの非表示シートを削除（日時変更なし）
Sub フォルダ内全ブック設定()
    Dim strfld As Variant
    'フォルダとファイル名消去
   Cells(2, 1) = "" 'フォルダ消去
    Range(Cells(4, 1), Cells(4, 2).End(xlDown)) = ""
    'フォルダ選択ダイアログ表示
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            strfld = .SelectedItems(1) ' & "\"
            Cells(2, 1) = strfld
        Else: MsgBox ("処理を中止します！"): Exit Sub
        End If
    End With

    Dim f As Variant    'ファイル用
    Dim d As Date       '更新日時保存用
    Dim sh As Worksheet 'ワークシート用
    Dim n As Long, i As Long 'カウンター用
    Dim jyogai(2) As String '除外シート名保存用
    For i = 0 To 2
        jyogai(i) = Cells(i + 12, 4)
    Next
    'チラつきをなくすためExcelインスタンスで対応
    Dim tgwb As Object
    Dim owb As Excel.Workbooks
    Dim oxl As Excel.Application
    Dim objShell As Object
    Dim objFld As Object
    Dim objFile As Object
    Dim pw As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    pw = Cells(4, 5)
    i = 4   '4行目から開始なので
    'フォルダ内のファイル数分のループ処理
    For Each f In fso.getFOLDER(strfld).Files
        Cells(i, 1) = f.Name    'ファイル名をセルに書き出す
        d = f.DateLastModified  ' 更新日時を取得
        
        Set oxl = CreateObject("Excel.Application")
        Set owb = oxl.Application.Workbooks
        If GetInputState() Then DoEvents '重いファイル用対策
        'ファイルを開く
        Set tgwb = owb.Open(fileName:=f, UpdateLinks:=0, Password:=pw)
        '開いたブックに対する処理
        With tgwb
            '共有の場合解除
            If .MultiUserEditing = True Then
                .UnprotectSharing
                .ExclusiveAccess
            End If
            n = 0   '削除数カウント初期化
            For Each sh In .Worksheets '非表示シートを削除
                If sh.Visible = xlSheetHidden Then
                    Select Case sh.Name '除外シートを確認
                        Case jyogai(0), jyogai(1), jyogai(2)
                        Case Else: sh.Delete: n = n + 1 '削除
                    End Select
                End If
            Next sh
        End With
        If GetInputState() Then DoEvents
        'ファイルを閉じる
        tgwb.Close (True)
        'オブジェクト初期化
        Set tgwb = Nothing
        Set owb = Nothing
        Set oxl = Nothing
        
        Cells(i, 2) = n '削除したシート数
        i = i + 1 'インクリメント
        'ここから更新日時を戻す処理（不要の場合はパス）
        If Cells(3, 3) = 1 Then
            Set objShell = CreateObject("Shell.Application") 'インスタンス化
            Set objFld = objShell.Namespace(strfld) 'フォルダを取得
            Set objFile = objFld.ParseName(f.Name) 'ファイルを取得
            '更新日時を元に戻す
            objFile.ModifyDate = d
            'オブジェクト初期化
            Set objFile = Nothing
            Set objFld = Nothing
            Set objShell = Nothing
        End If
    Next
    Erase jyogai
    Set fso = Nothing
    If Cells(4, 1) <> "" Then MsgBox ("非表示シートの削除が完了しました！")
End Sub

Option Explicit
Private Declare Function GetInputState Lib "USER32" () As Long 'DoEventsの代わり
'選択ファイルの非表示シートを削除して日時変更せずに保存
Sub 個別ファイルを設定()
    Dim vFileName As Variant
    Dim strfld As Variant
    'フォルダとファイル名消去
    Cells(2, 1) = "" 'フォルダ消去
    Range(Cells(4, 1), Cells(4, 2).End(xlDown)) = ""
    '「ファイルを開く」ダイアログの表示
    vFileName = Application.GetOpenFilename( _
                FileFilter:="Excelワークブック,*.xls?", _
                Title:="ファイルを指定して下さい", _
                MultiSelect:=True)
    If IsArray(vFileName) = False Then _
                MsgBox ("処理を中止します！"): Exit Sub
    Dim f As Variant    'ファイル用
    Dim fn As Variant   'ファイル名保存用
    Dim d As Date       '更新日時保存用
    Dim sh As Worksheet 'ワークシート用
    Dim n As Long, i As Long 'カウンター用
    Dim jyogai(2) As String '除外シート名保存用
    For i = 0 To 2
        jyogai(i) = Cells(i + 12, 4)
    Next
    'チラつきをなくすためExcelインスタンスで対応
    Dim tgwb As Object
    Dim owb As Excel.Workbooks
    Dim oxl As Excel.Application
    '更新日時書き換えにShellオブジェクトを使う
    Dim objShell As Object
    Dim objFld As Object
    Dim objFile As Object
    Dim pw As String    'Password用
    Dim fso As Object   'ファイルシステムオブジェクト
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    pw = Cells(4, 5)
    i = 4  '4行目から開始なのでカウンター初期化
    For Each f In vFileName 'フォルダ内のファイルを取得
        If i = 4 Then '最初のファイルでフォルダ取得
            strfld = Left(f, InStrRev(f, "\")) 'フォルダPath
            Cells(2, 1) = strfld
        End If
        fn = fso.GetFilename(f) 'ファイル名セット
        Cells(i, 1) = fn
        d = fso.GetFile(f).DateLastModified ' 更新日時を取得
     
        Set oxl = CreateObject("Excel.Application") 'インスタンス
        Set owb = oxl.Application.Workbooks
        If GetInputState() Then DoEvents '重いファイル用対策
        'ファイルを開く
        Set tgwb = owb.Open(fileName:=f, UpdateLinks:=0, Password:=pw)
        '開いたブックに対する処理
        With tgwb
            '共有の場合解除
            If .MultiUserEditing = True Then
                .UnprotectSharing
                .ExclusiveAccess
            End If
            n = 0   '削除数カウント初期化
            For Each sh In .Worksheets '非表示シートを削除
                If sh.Visible = xlSheetHidden Then
                    Select Case sh.Name '除外シートを確認
                        Case jyogai(0), jyogai(1), jyogai(2)
                        Case Else: sh.Delete: n = n + 1 '削除
                    End Select
                End If
            Next sh
        End With
        If GetInputState() Then DoEvents 'DoEvents
        'ファイル保存して閉じる
        tgwb.Close (True)
        'オブジェクト初期化
        Set tgwb = Nothing
        Set owb = Nothing
        Set oxl = Nothing
        '削除したシート数を書き込む
        Cells(i, 2) = n
        i = i + 1   'インクリメント
        'ここから更新日時を戻す処理（不要の場合はパス）
        If Cells(3, 3) = 1 Then
            Set objShell = CreateObject("Shell.Application") 'インスタンス化
            Set objFld = objShell.Namespace(strfld) 'フォルダを取得
            Set objFile = objFld.ParseName(fn) 'ファイルを取得
            '更新日時を元に戻す
            objFile.ModifyDate = d
            'オブジェクト初期化
            Set objFile = Nothing
            Set objFld = Nothing
            Set objShell = Nothing
        End If
    Next
    Erase jyogai
    Set fso = Nothing
    If Cells(4, 1) <> "" Then MsgBox ("非表示シートの削除が完了しました！")
End Sub