Excel, bouton enregistrer sur le bureau

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,

1 réponse

  1. Contributeur
    0
    1. 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
    2. Contributeur
      @rheopiTout 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