Microsoft 365 Enregistrer sous sans boite de dialogue enregistrer et oui

[iliess]

bonjour
Voici Marco suivant qui oblige l'utilisateur a enregistrer sous le fichier avec un nom et emplacement et extension bien définie a l'avance mais seulement je souhaite le click sur enregistrer et oui ce faite d'une manière automatique

Sub Enre_sous2()
Dim Emplacement As String
Dim Fichier As String
' Nom de l'Emplacement
Emplacement = "D:\TVA"
'Nom du Fichier
Fichier = Range("A1")
Sous = Emplacement & "\" & Fichier
F = Application.GetSaveAsFilename(Sous, Filefilter:="Classeur Excel (*.xlsx), *.xlsx*")
If F = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=F, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

End Sub

je souhaite que les boites de dialogues se faite automatique.

 

[Jacky67]

bonjour
Voici Marco suivant qui oblige l'utilisateur a enregistrer sous le fichier avec un nom et emplacement et extension bien définie a l'avance mais seulement je souhaite le click sur enregistrer et oui ce faite d'une manière automatique

Sub Enre_sous2()
Dim Emplacement As String
Dim Fichier As String
' Nom de l'Emplacement
Emplacement = "D:\TVA"
'Nom du Fichier
Fichier = Range("A1")
Sous = Emplacement & "\" & Fichier
F = Application.GetSaveAsFilename(Sous, Filefilter:="Classeur Excel (*.xlsx), *.xlsx*")
If F = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=F, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

End Sub

je souhaite que les boites de dialogues se faite automatique.

Regarde la pièce jointe 1147119
Regarde la pièce jointe 1147120

Bonjour,
Le code ci-dessous attribué à un bouton pourrait ressembler à ceci

Sub Enre_sous2()
    Dim Emplacement As String, Fichier As String
    ' Nom de l'Emplacement
    Emplacement = "D:\TVA\"
    'Nom du Fichier
    Fichier = Range("a1") 'Nom du classeur sans l'extension
    If Fichier = "" Then MsgBox "Nom du classeur manquant": Exit Sub
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Emplacement & Fichier, 52
End Sub

 

[kiki29]

Salut, à toi de poursuivre

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

 

[iliess]

Merci beaucoup Mr Jacky et Mr KiKi ca marche très bien