MyRibbonTools B04_CsvCommomTools

Option Explicit
'********************************************************************
'    CSVインポート用の共通関数
'********************************************************************
'***=========================================================***
' 【目的】ユーザーにCSVファイルを選択させるダイアログを表示し、選択されたファイルパスを返す
' 【処理内容】
'    - 初期フォルダは、ThisWorkbook.Path + wsCtrl.Range("D7") の値
'    - CSVファイルとすべてのファイルをフィルターに設定
'    - キャンセルされた場合は空文字を返す
'***=========================================================***
Function SelectCsvFile() As Variant

    Dim fileDialog As fileDialog
    Dim initialFolder As String

    initialFolder = ThisWorkbook.Path & "\" & wsCtrl.Range("D7").Value
    Set fileDialog = Application.fileDialog(msoFileDialogOpen)

    With fileDialog
        .AllowMultiSelect = False
        .Title = "CSVファイルを選択してください"
        .InitialFileName = initialFolder
        .Filters.Clear
        .Filters.Add "CSVファイル", "*.csv"
        .Filters.Add "すべてのファイル", "*.*"
    End With

    If fileDialog.Show = -1 Then
        SelectCsvFile = fileDialog.SelectedItems(1)
    Else
        MsgBox "ファイル選択がキャンセルされました。", vbInformation
        SelectCsvFile = ""
    End If

    Set fileDialog = Nothing

End Function
'***=========================================================***
' 【目的】指定されたベース名に対して、既存のシート名と重複しない新しい名前を返す
'   引数　：baseName（String）… 基本となるシート名
'   戻り値：重複しない新しいシート名（String）
' 【処理内容】
'    - "Data", "Data2", "Data3" ... のように命名
'    - 既存シート名と照合して、重複しない名前を返す
'***=========================================================***
Function GetNextAvailableSheetName(baseName As String) As String

    Dim i As Long
    Dim nameExists As Boolean
    Dim candidateName As String

    i = 1
    Do
        '▼候補名を生成（最初はそのまま、以降は連番付き）
        candidateName = baseName & IIf(i = 1, "", i)
        nameExists = SheetExistsInThisBook(candidateName)
        i = i + 1
    Loop While nameExists

    '▼重複しない名前を返す（例："Data3"）
    GetNextAvailableSheetName = candidateName

End Function
'***=========================================================***
' 【目的】指定されたベース名のシートを準備する。
'         既存シートにテーブルがある場合は上書き・新規・キャンセルを選択。
' 【処理内容】
'    - シートが存在しない場合は新規作成
'    - 存在するがテーブルがある場合は MsgBox で確認
'    - テーブル削除＋セルクリア（上書き時）
'***=========================================================***
'**********************************************************
' 関数名：PrepareSheetWithConfirmation
'
' 概要　：指定されたベース名のシートを準備する。
'　　　　既存シートにテーブルがある場合は上書き・新規・キャンセルを選択。
'
' 処理内容：
'    - シートが存在しない場合 → 新規作成
'    - 存在するがテーブルあり → MsgBoxで確認（上書き／新規／キャンセル）
'    - 上書き時はテーブル削除＋セルクリア
'
' 引数　：baseName（String）… 基本シート名（例："Color見本"）
' 戻り値：Worksheetオブジェクト（準備されたシート）
'**********************************************************
Function PrepareSheetWithConfirmation(baseName As String) As Worksheet

    Dim targetSheetName As String
    Dim response As VbMsgBoxResult
    Dim lo As ListObject

    '初期候補名（重複回避用）
    targetSheetName = GetNextAvailableSheetName(baseName)

    '既存シートがある場合
    If SheetExistsInThisBook(baseName) Then

        With ThisWorkbook.Sheets(baseName)
            'テーブルが存在する場合は確認
            If .ListObjects.Count > 0 Then
                response = MsgBox("'" & baseName & "' シートに既存テーブルがあります。" & vbCrLf & _
                                  "上書きしますか？" & vbCrLf & _
                                  "「いいえ」で新規作成、「キャンセル」で処理を中止します。", _
                                  vbYesNoCancel + vbQuestion)

                Select Case response
                    Case vbYes
                        targetSheetName = baseName
                    Case vbNo
                        targetSheetName = GetNextAvailableSheetName(baseName)
                        ThisWorkbook.Sheets.Add(After:=ActiveSheet).Name = targetSheetName
                    Case vbCancel
                        Set PrepareSheetWithConfirmation = Nothing
                        Exit Function
                End Select
            Else
                targetSheetName = baseName
            End If
        End With

    Else
        '存在しない場合は新規作成
        ThisWorkbook.Sheets.Add(After:=ActiveSheet).Name = targetSheetName
    End If

    '対象シートの取得と初期化
    Set PrepareSheetWithConfirmation = ThisWorkbook.Sheets(targetSheetName)

    With PrepareSheetWithConfirmation
        .Select      ' ← 画面操作が不要なら削除OK

        'テーブル削除
        For Each lo In .ListObjects
            lo.Delete
        Next lo

        'セルクリア
        .Cells.Clear
    End With

End Function
'***=========================================================***
' 【目的】指定されたベース名に対して、ブック内で重複しないテーブル名を生成する。
' 【処理内容】
'    - 全てのシートのテーブル名をチェック
'    - "ImportedTable", "ImportedTable2", "ImportedTable3" ... のように命名
'***=========================================================***
'**********************************************************
' 関数名：GetUniqueTableName
'
' 概要　：指定されたベース名に対して、既存のテーブル名と重複しない新しい名前を生成する。
'　　　　"Table", "Table2", "Table3" ... のように命名。
'
' 引数　：baseName（String）… 基本となるテーブル名
' 戻り値：重複しない新しいテーブル名（String）
'
' 使用例：GetUniqueTableName("色見本") → "色見本2" など
'**********************************************************
Function GetUniqueTableName(baseName As String) As String

    Dim lo As ListObject
    Dim ws As Worksheet
    Dim i As Long
    Dim nameExists As Boolean
    Dim candidateName As String

    i = 1
    Do
        '▼候補名を生成（最初はそのまま、以降は連番付き）
        candidateName = baseName & IIf(i = 1, "", i)
        nameExists = False

        '▼全シートのテーブル名と照合
        For Each ws In ThisWorkbook.Worksheets
            For Each lo In ws.ListObjects
                If lo.Name = candidateName Then
                    nameExists = True
                    Exit For
                End If
            Next lo
            If nameExists Then Exit For
        Next ws

        i = i + 1
    Loop While nameExists

    '▼重複しない名前を返す（例："色見本3"）
    GetUniqueTableName = candidateName

End Function

'********************************************************************