Sub CreerRaccourci()
Dim raccourci As Object, bureau$, fLNK$
bureau = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
With ActiveWorkbook
'Vérifie l'existence d'un chemin pour le classeur
If .Name <> .FullName Then
fLNK = Dir$(bureau & "ONLINE*xls" & ".lnk")
If (Len(fLNK) > 0) Then
Kill bureau & fLNK
refresh
End If
With CreateObject("WScript.Shell")
Set raccourci = .CreateShortcut(bureau & ActiveWorkbook.Name & ".lnk")
End With
'Crée le raccourci sur le bureau Windows
raccourci.TargetPath = .FullName
raccourci.Save
End If
End With
End Sub
Sub refresh()
'source - Rems [080708]
Dim objSh, strDesktop
Set objSh = CreateObject("WScript.Shell")
strDesktop = objSh.SpecialFolders("Desktop")
objSh.AppActivate strDesktop
WScript.Sleep 727
objSh.SendKeys "{F5}"
End Sub