FIx 工作表循环

问：

我有要求选择 .xlsx 文件以在所选文件中执行字符替换的代码。问题是当它浏览工作表时，会弹出打开对话框，要求打开文件的时间与所选文件中的工作表一样多。我该如何解决？

Option Explicit

Sub ReplaceCharactersInSelectedFiles()
    Dim FileDialog As FileDialog
    Dim SelectedFiles As FileDialogSelectedItems
    Dim AccChars As String
    Dim RegChars As String
    Dim NewFileName As String
    Dim i As Long
    Dim ws As Worksheet
    Dim OriginalCalculationMode As XlCalculation
    Dim CurrentWorkbook As Workbook
    
    ' Store the original calculation mode and set to manual to improve performance
    OriginalCalculationMode = Application.Calculation
    Application.Calculation = xlCalculationManual

    ' Ask the user to select multiple .xlsx files
    Set FileDialog = Application.FileDialog(msoFileDialogFilePicker)
    FileDialog.Title = "Select .xlsx Files"
    FileDialog.Filters.Clear
    FileDialog.Filters.Add "Excel Files", "*.xlsx"
    
    If FileDialog.Show = -1 Then
        Set SelectedFiles = FileDialog.SelectedItems
        
        ' Read AccChars from cell B10 of the active worksheet
        AccChars = ActiveSheet.Range("B10").Value

        ' Read RegChars from cell B11 of the active worksheet
        RegChars = ActiveSheet.Range("B11").Value

        ' Loop through the selected files
        For i = 1 To SelectedFiles.Count
            ' Open the workbook in read-only mode without displaying it
            Set CurrentWorkbook = Workbooks.Open(SelectedFiles(i), ReadOnly:=True)
            
            ' Loop through all sheets in the workbook
            For Each ws In CurrentWorkbook.Sheets
                ' Perform character replacement in the current sheet
                StripAccent ws.UsedRange, AccChars, RegChars
            Next ws
            
            ' Save the modified file with "noChar" added to its filename
            NewFileName = Left(CurrentWorkbook.FullName, InStrRev(CurrentWorkbook.FullName, ".") - 1) & "_noChar.xlsx"
            CurrentWorkbook.SaveAs NewFileName
            CurrentWorkbook.Close SaveChanges:=False
        Next i
    End If

    ' Restore the original calculation mode
    Application.Calculation = OriginalCalculationMode
End Sub

Sub StripAccent(aRange As Range, ByVal AccChars As String, ByVal RegChars As String)
    Dim A As String * 1
    Dim B As String * 1
    Dim i As Integer

    For i = 1 To Len(AccChars)
        A = Mid(AccChars, i, 1)
        B = Mid(RegChars, i, 1)
        aRange.Replace What:=A, Replacement:=B, LookAt:=xlPart, MatchCase:=True
    Next
End Sub

代码有效，但我必须多次按取消作为所选文件中的工作表。请帮忙