Private Sub CommandButton1_Click()
'myDearFriend! -www.mdf - xlpages.com
Dim Raccourci As Object
With ActiveWorkbook
'Vérifie l'existence d'un chemin pour le classeur
If .Name <> .FullName Then
'Défini le raccourci
With CreateObject("WScript.Shell")
Set Raccourci = .CreateShortcut(.SpecialFolders("Desktop") _
& "\" & ActiveWorkbook.Name & ".lnk")
End With
With Raccourci
'Affecte l'icône (chemin à adapter)
.iconlocation = "\\SRVPROD\commun_mairie\conge.ico"
'Crée le raccourci sur le bureau Windows
.TargetPath = ActiveWorkbook.FullName ' le chemin est identifié
.Save
End With
Else
MsgBox "Sauvegardez déjà le classeur sur le DD et recommencez..."
End If
End With
End Sub