Excel, bouton enregistrer sur le bureau

rheopi -
cs_Le Pivert Messages postés 8437 Statut Contributeur - 19 janv. 2021 à 18:04

Bonjour la compagnie !

J'ai un p'tit soucis, j'vous explique tout cela en détail ! mettez vous à l'aise, vous allez être transporté !

Je suis actuellement en train de faire un classeur fiche prospect pour des commerciaux qui ne sont pas à l'aise avec Excel ! (D'ailleurs moi aussi, coucou j'suis là !). Donc pour ce faire, j'ai fait un bouton envoi mail qui fonctionne à merveille puis, arrivons au vif du sujet... Une commande pour enregistrer sur le bureau.

Je m'explique, le but c'est d'enregistrer sous un nom, genre robert cela met directement le fichier xlsx sur le bureau... Puis ils appuient sur le bouton et pif paf pouf ça envoi sur outlook.

J'ai donc pensé à cette formulation pour l'enregistrer sous (pompé sur le net):

Sub enregistrer1()
Dim nom_doc As String, nom_ent
'demande quel nom donner au document
nom_doc = InputBox("Quel nom pour votre document ?", "Nom du document")
If nom_doc = "" Then Exit Sub
nom_ent = chemin_pub & "/" & nom_doc & ".xlsx"
ActiveDocument.SaveAs nom_ent
End Sub

Mais... yé suis bloqué ! au moment pour enregistrer cela n'arrive pas à bout. Me ferez vous l'honneur de me partager votre savoir pour faciliter la vie de 3 petits hommes, galopant dans la prairie?

Cordialement,

Afficher la suite

1 réponse

cs_Le Pivert Messages postés 8437 Statut Contributeur 730

Bonjour,

voir ceci:

https://excel-malin.com/codes-sources-vba/trouver-chemin-de-bureau/

rheopi

Sub enregistrer1()
Dim nom_doc As String, nom_ent
'demande quel nom donner au document
nom_doc = InputBox("Quel nom pour votre document ?", "Nom du document")
If nom_doc = "" Then Exit Sub
nom_ent = chemin_pub & "/" & nom_doc & ".xlsx"
ActiveDocument.SaveAs nom_ent
On Error GoTo TestErreur
Dim CheminBureau As String

CheminBureau = oWSHShell.SpecialFolders()

MsgBox CheminBureau 'affiche le chemin vers le dossier Bureau
Exit Sub
TestErreur:
MsgBox "Une erreur s'est produite..."
End Sub

Ils me mettent erreur d'exécution 424 > objet requis..... Outch je suis vraiment un petit poussin dans le domaine, je ne comprend pas vraiment le lien fourni x)(du moins le code) serait t il possible d'avoir un p'tit coup de patte? :)

cs_Le Pivert Messages postés 8437 Statut Contributeur 730 > rheopi

Tout est expliqué dans le lien fourni!
Il suffit de faire un copier coller!

Option Explicit
Dim dossier As String
Dim bureau As String
Dim nom_doc As String
'***********************************************************************
'Enregistrer
'***********************************************************************
Sub Enregistrer()
Application.DisplayAlerts = False
cheminbureau
dossier = bureau & "\"
nom_doc = InputBox("Quel nom pour votre document ?", "Nom du document")
If nom_doc = "" Then Exit Sub
 ActiveWorkbook.SaveAs Filename:=dossier & nom_doc & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
  MsgBox "Enregistrement du classeur sur le Bureau", vbInformation, "Enregistrement"
    Application.DisplayAlerts = True
End Sub
Private Sub cheminbureau()
'https://excel-malin.com/codes-sources-vba/trouver-chemin-de-bureau/

    On Error GoTo TestErreur
    Dim cheminbureau As String
    
    cheminbureau = ObtenirCheminBureau()
    
    bureau = cheminbureau 'affiche le chemin vers le dossier Bureau
    Exit Sub
TestErreur:
    MsgBox "Une erreur s'est produite..."
End Sub
Public Function ObtenirCheminBureau() As String
'par: Excel-Malin.com ( https://excel-malin.com )

    On Error GoTo ObtenirCheminBureauError
    Dim cheminbureau As String
    cheminbureau = ""
    Dim oWSHShell As Object
    Set oWSHShell = CreateObject("WScript.Shell")
    
    cheminbureau = oWSHShell.SpecialFolders("Desktop")
    
    If (Not (oWSHShell Is Nothing)) Then Set oWSHShell = Nothing
    ObtenirCheminBureau = cheminbureau

    Exit Function
ObtenirCheminBureauError:
    If (Not (oWSHShell Is Nothing)) Then Set oWSHShell = Nothing
    ObtenirCheminBureau = ""
End Function

Voilà y a plus ka

@+ Le Pivert

Excel, bouton enregistrer sur le bureau

1 réponse

Discussions similaires

Newsletters