Option Explicit
Sub CreerRaccourci()
Dim Raccourci As Object, chemin As String, fichier As String, classeur As String
chemin = "C:\Users\" & Environ("Username") & "\Desktop\Nouveau dossier\"
classeur = "Gest" 'Nom du nouveau classeur ou raccourci
fichier = chemin & "gestion.ico"
With ActiveWorkbook
.SaveAs Filename:=chemin & classeur & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
If .Name <> .FullName Then
With CreateObject("WScript.Shell")
Set Raccourci = .CreateShortcut(chemin & classeur & ".lnk")
With Raccourci
.iconlocation = fichier
.TargetPath = ActiveWorkbook.FullName
.Save
End With
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.Quit
End With
Else
MsgBox "Sauvegardez déjà le classeur sur le DD et recommencez...", , "IMAGE .ICO"
End If
End With
End Sub