Excel, bouton enregistrer sur le bureau

rheopi -  
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   -
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,
A voir également:

1 réponse

cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
0
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? :)
0
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729 > 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
0