New-B01

Option Explicit

' +++********************************************************+++
'     フォルダを作成（wsCtrlの指定セルから）
' +++********************************************************+++
Sub MakeFdr()

    Dim fdrName As String
    Dim i As Long
    Dim r As Long
    Dim varRow As Variant

    Dim nmlTmn As Boolean           '正常終了フラグ：normal Termination

    nmlTmn = False
    myProcd = "MakeFdr"

    On Error GoTo MakeFdr_Err

    Call showStatus("フォルダ作成 中")
    Call StopUpdating
    Call SetObject

    varRow = Split("7,14", ",")
    With wsCtrl
        For i = 0 To UBound(varRow)
            r = CLng(varRow(i))
            fdrName = Trim(.Cells(r, 4))
            fdrName = ThisWorkbook.Path & "\" & fdrName
            If Dir(fdrName, vbDirectory) = "" Then
                MkDir fdrName
            End If
        Next i
    End With

    nmlTmn = True

MakeFdr_Exit:
    On Error Resume Next
    Call ReSetObject
    Call Updating
    If nmlTmn Then MsgBox " 完了♪"
    On Error GoTo 0
    Exit Sub

MakeFdr_Err:
    MsgBox "実行時エラー:" & Err.Number & vbCrLf & _
           Err.Description & vbCrLf & _
           "処理を終了します。", vbExclamation, myProcd
    Err.Clear
    GoTo MakeFdr_Exit

End Sub

'================================================
'   指定シートのデータをテーブルに変換する（引数付き）
'   Call ConvertToTable(wsWork, "ImportedTable")
'================================================
Sub ConvertToTable(ByVal targetSheet As Worksheet, ByVal tableName As String)
    Dim tblRange As Range
    Dim tblObj As ListObject
    Dim MaxRow As Long
    Dim MaxCol As Long

    With targetSheet
        ' 最終行・最終列を取得
        MaxRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        MaxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

        ' テーブル範囲を設定（A1から最終セルまで）
        Set tblRange = .Range(.Cells(1, 1), .Cells(MaxRow, MaxCol))

        ' 既存テーブルがあれば削除（重複防止）
        On Error Resume Next
        For Each tblObj In .ListObjects
            tblObj.Delete
        Next
        On Error GoTo 0

        ' テーブルを作成（引数で指定された名前を付ける）
        .ListObjects.Add(xlSrcRange, tblRange, , xlYes).Name = tableName
    End With
End Sub
'+++*******************************************************+++
'    フィルター解除（テーブルでも通常フィルターでも対応）
'+++*******************************************************+++
Public Sub ClearAllFilters()
    Dim lo As ListObject
    Dim ws As Worksheet
    Set ws = ActiveSheet

    ' テーブルのフィルター解除
    For Each lo In ws.ListObjects
        If lo.ShowAutoFilter Then lo.AutoFilter.ShowAllData
    Next lo

    ' 通常フィルターの解除
    If ws.AutoFilterMode Then
        If ws.FilterMode Then ws.ShowAllData
    End If
End Sub
'+++*******************************************************+++
'    csvが開かれているか確認
'+++*******************************************************+++
Function IsFileOpen(filePath As String) As Boolean
    Dim ff As Integer
    On Error Resume Next
    ff = FreeFile
    Open filePath For Binary Access Read Write Lock Read Write As #ff
    If Err.Number <> 0 Then
        IsFileOpen = True
    Else
        IsFileOpen = False
        Close #ff
    End If
    On Error GoTo 0
End Function
'+++*******************************************************+++
'   　全シートA1に画面スクロール
'+++*******************************************************+++
Sub exeAllA1()
    Dim i As Long
    Call StopUpdating
    Call showStatus("セルA1 画面セット中")
    
    If IsCall = False Then Call StopUpdating
    
    With ActiveWorkbook
        'エラーを無視
        On Error Resume Next
        For i = .Sheets.Count To 1 Step -1
            With .Worksheets(i)
                If .Visible Then
                    .Select
                    Application.GoTo reference:=Range("A1"), _
                                     Scroll:=True
                End If
            End With
        Next i
        'エラー制御を戻す
        On Error GoTo 0
    End With
    If IsCall = False Then Call Updating
    '最小化
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then
        Windows(ThisWorkbook.Name).WindowState = xlMinimized
    End If
End Sub