Excel VBA enregistrer fichier bureau & renommer par rapport à une cellule

Résolu/Fermé
yugu_8551 Messages postés 5 Date d'inscription jeudi 14 février 2019 Statut Membre Dernière intervention 15 février 2019 - 14 févr. 2019 à 11:41
yugu_8551 Messages postés 5 Date d'inscription jeudi 14 février 2019 Statut Membre Dernière intervention 15 février 2019 - 15 févr. 2019 à 09:48
Bonjour

je début sur les macro et j'ai besoin de votre aide.

je m'explique:

j'ai un classeur Excel avec plusieurs feuilles, seule la première est importante, les autres sont masquées". Pour l'ergonomie certaine cellules sont fusionnées. Sur la première feuille, précisément sur la cellule B7, je met un numéro à 8 chiffres ex"19005695".

Après avoir complété mon tableau, j'aimerai créer un bouton TERMINÉ, qui lui m'enregistrera une copie de ce classeur sur le bureau sous le numéro de la cellule B7 "19005695", tout en conservant mon classeur initial vierge (sans les données).

j'espère trouver une personne qui pourra d'aider, merci d'avance et surtout de votre patience. Merci d'avance pour votre aide précieuse

1 réponse

cs_Le Pivert Messages postés 7893 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 19 mai 2023 725
14 févr. 2019 à 14:35
Bonjour,

Faire Alt F11 pour accéder à l'éditeur, ensuite insérer un Module.

Mettre ce code dans ce module:

Option Explicit
Dim dossier As String
Dim bureau As String
Sub Enregistrer()
Application.DisplayAlerts = False
cheminbureau
dossier = bureau & "\"
 ActiveWorkbook.SaveAs Filename:=dossier & Sheets("Feuil1").Range("B7").Value & ".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


pour lancer la macro mettre un bouton aller dans Développeur, Mode Création:
Inserer control formulaire Bouton. Clic droit sur le bouton:
Affecter une macro, sélectionner Enregistrer
Le bouton est opérationnel




0
yugu_8551 Messages postés 5 Date d'inscription jeudi 14 février 2019 Statut Membre Dernière intervention 15 février 2019
14 févr. 2019 à 15:44
Bonjour,

Merci tout d'abord de prendre le temps de me répondre! Il semblerait que cela ne fonctionne pas, puis-je vous faire parvenir le fichier ?
0
cs_Le Pivert Messages postés 7893 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 19 mai 2023 725
14 févr. 2019 à 15:46
en passant par là

https://www.cjoint.com/

ensuite copier le lien ici
0