Microsoft 365 Enregistrer sous sans boite de dialogue enregistrer et oui

Option Explicit

Sub Enrengistrement()
Dim Emplacement As String
Dim Fichier As String
Dim Sous As String

    Emplacement = "D:\TVA"
    Fichier = Range("A1")
    Sous = Emplacement & "\" & Fichier

    If NomValide(Fichier) = False Then
        Range("A1").Select
        MsgBox "Nom de fichier invalide", vbCritical + vbOKOnly
        Exit Sub
    End If
   
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=Sous, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Application.DisplayAlerts = True
End Sub

Private Function NomValide(sChaine As String) As Boolean
Dim i As Long
Const sCaracInterdits As String = """*/:<>?\|"
    NomValide = True
    If Len(sChaine) = 0 Then
        NomValide = False
        Exit Function
    End If
    For i = 1 To Len(sCaracInterdits)
        If InStr(sChaine, Mid$(sCaracInterdits, i, 1)) > 0 Then
            NomValide = False
            Exit Function
        End If
    Next i
End Function