Bouton enregistrer sous

Question

Je reviens vers vous pour une aide. Je souhaiterai avoir un bouton enregistrer sous, sur mes devis ( format pdf) , afin de pourvoir sauvegarder chaque devis. je voudrais une fenêtre qui s'ouvre pour me demander dans quel dossier ( Janvier, Février, Mars...etc), dans mon dossier facture/devis Dans le même temps est il possible d'avoir un autre bouton dans la facture et devis qui cet fois ci servirai à envoyer par mail ( Gmail). Ci-joint mon dossier excel...

Koko_Swiff · Answer

Voici un exemple à adapter, n'hésite pas si tu as des questions ! A+ bon week...

Koko_Swiff · Answer

Re,

Alors voici comment ça fonctionne :

tu peux ouvrir l'éditeur VBA depuis l'onglet développeur ou en faisant ALT F11 :

Ensuite dans module 1 tu as le code :

Function RenvoieNomFichier() As String
RenvoieNomFichier = Application.Caller.Parent.Parent.Name
End Function

Cela ne sert à rien j'ai oublié de l'enlever mdr

Dim finput As FileDialog
Set finput = Application.FileDialog(msoFileDialogFolderPicker) 'fenêtre de choix
finput.Show 'ouvre la fenêtre

With finput
Sheets("Feuil1").Cells(1, 8) = .SelectedItems(1) l'item sélectionné (le nom du dossier) est conservé sur la feuille 1 
End With

Cela c'est ce qui ouvre le fichier pour sélectionner le dossier dans lequel tu veux enregistrer

Dim sRep As String                  ' Répertoire de sauvegarde
Dim sFilename As String             ' Nom du fichier
Dim reponse As String
Dim reponse2 As Long

reponse = InputBox("Donner un nom à votre fichier") 'nom du fichier

If reponse = "" Then 'si aucun nom alors erreur
MsgBox ("L'enregistrement à échoué")
Exit Sub
Else
End If

sRep = Sheets("Feuil1").Range("H1").Value                     ' Répertoire de sauvegarde (si non spécifié, répertoire actif par défaut)
sFilename = reponse      ' Nom du fichier
Sheets("Feuil1").Range("H2").Value = reponse 'on conserve le nom du fichier

ActiveSheet.ExportAsFixedFormat _ 'on exporte en pdf la feuille active
                     Type:=xlTypePDF, _
                     Filename:=sRep & "\" & sFilename, _
                     Quality:=xlQualityStandard, _
                     IncludeDocProperties:=True, _
                     IgnorePrintAreas:=False, _
                     OpenAfterPublish:=False

Sheets("Feuil1").Range("H3").Value = sRep & "\" & reponse & ".pdf" 'on enregistre le chemin (dossier + fichier) en feuille 1

reponse2 = MsgBox("La base de donnée à bien été enregistrer, souhaitez vous l'ouvrir ?", _ 
vbYesNo + vbQuestion + vbDefaultButton1, _
"")

If reponse2 = vbYes Then

Call OuvrirUnFichierPDF 'ouvrir le fichier en question via la macro ouvrirunfichierpdf décrite ci dessous

Else
End If

Exit Sub

End Sub

Public Function OuvrirFichier(MonFichier As String) 'fonction qui vérifie si un fichier existe bien
'par Excel-Malin.com ( http://excel-malin.com )

On Error GoTo OuvertureFichierErreur

   'vérifie si le fichier existe
   If Len(Dir(MonFichier)) = 0 Then
    OuvrirFichier = False
    MsgBox ("Le fichier n'existe pas")
    Exit Function
   Else
   End If

   'ouvre le fichier dans son application associée
   Dim MonApplication As Object
   Set MonApplication = CreateObject("Shell.Application")

    MonApplication.Open (MonFichier)
    OuvrirFichier = True
   Set MonApplication = Nothing

Exit Function
OuvertureFichierErreur:
   Set MonApplication = Nothing
    OuvrirFichier = False
End Function

Sub OuvrirUnFichierPDF()
'par Excel-Malin.com ( http://excel-malin.com )

'ceci va lancer Acrobat Reader et ouvrir le fichier créé précédemment
OuvrirFichier (Sheets("Feuil1").Range("H3").Value)

End Sub

Sans VBA je ne vois pas comment tu pourrais faire, ou alors j'ai mal compris la question ...