Microsoft 365 Enregistrer sous sans boite de dialogue enregistrer et oui

iliess

XLDnaute Occasionnel
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

VB:
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.

Boite De dialogue 1.png

Boite De dialogue 2.png
 
Solution
Salut, à toi de poursuivre
VB:
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...

Jacky67

XLDnaute Barbatruc
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

VB:
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
VB:
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

XLDnaute Barbatruc
Salut, à toi de poursuivre
VB:
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
 
Dernière édition:

Discussions similaires

Réponses
3
Affichages
593

Statistiques des forums

Discussions
313 276
Messages
2 096 761
Membres
106 743
dernier inscrit
sshkm16