Bonjour à tous

C'est mon premier message sur ce site, belle présentation.
je commence par une question sur le raccourci bureau.
j'ai récupéré une macro vba que j'ai adapté, tout marche bien.
J'ai créé une icône, pour lancer mon programme.
Ce que je désire c'est modifier la macro pour qu'il aille chercher mon icône
dans mon répertoire. Ainsi mon icône sera indépendant.

Salutation à tous
et merci d'avance

Jean-Paul

Bonjour à tous,
Bienvenue à Carioca

D'abord les "choses qui "fâchent"...

Peux-tu remplir ton profil pour renseigner ton environnement ?
Peux-tu prendre la bonne habitude de joindre ton code ou un bout de fichier lors d'une demande ?

J'avoue ne pas trop avoir compris ta demande (pense à donner le chemin de l'icone)

Au plaisir de te lire

Bonsoir carioca, JCGL, le Forum,

En premier lieu, je confirme ce que dit JCGL, il est toujours préférable de donner au moins le bout de code utilisé pour faciliter les réponses (voire de joindre un exemple).

Espérant avoir quand même compris ta demande, je te propose donc la solution suivante :
Tout d'abord, en se basant sur la solution donnée ici : FAQ - [VBA] Comment créer un raccourci du classeur actif sur le bureau Windows ?.

Pour pointer sur l'icône sauvegardée sur ton disque dur :

DANS UN MODULE DE CODE STANDARD


Par ailleurs, si la présente solution te convient, je t'invite à solder ta question sur XLD ICI, afin d'éviter que d'autres planchent sur ton problème pour rien... (merci aussi d'éviter les multiposts à l'avenir, ce n'est pas forcément bien apprécié des intervenants).

Cordialement,

EDITION :
Code VBA rectifié suite à la remarque judicieuse de Carioca.

Rebonjour JCGL

Désolé pour le profil, pas vu.
Par contre je ne connais pas les sigles ICQ,AIM,YIM
je complèterai par la suite.

Pour le module voici:

'======================================

Public Sub Raccourci()
Set wshshell = CreateObject("WScript.Shell")
strdesktop = wshshell.specialFolders("Desktop")
Utilisateur = Mid(strdesktop, 27, 8)
Set oshelllink = wshshell.createshortcut(strdesktop & "\Facture2.lnk") 'libellé du raccourci
oshelllink.targetPath = "c:\Factures\Facture2.xls" 'chemin du raccourci
oshelllink.WindowStyle = 1
oshelllink.HotKey = "CTRL+SHIFT+F" 'raccourci clavier
oshelllink.IconLocation = "c:\Facture2.ico" 'icône du raccourci
oshelllink.Description = "Cliquez ici Facture" 'Texte info-bulle du raccourci
oshelllink.WorkingDirectory = "c:" 'destination du raccourci
oshelllink.Save 'enregistre l'opération
End Sub

'=======================================

Mon but c'est d'avoir le même icône personnalisé sur plusieurs plateformes.


Merci pour la réponse

jean-paul

Re,

Merci d'avoir complété ton profil. L'environnement utilisé (PC) et ta version Excel (2000) était l'essentiel de ce que nous attendions pour pouvoir te répondre au mieux à l'avenir.
ICQ, AIM et YIM, respectivement "I Seek You", "AOL Instant Messenger" et "Yahoo Instant Messenger" sont des messageries instantanées, il n'y a bien sûr aucune obligation de compléter ces informations.

Par contre, tu n'as visiblement pas vu la réponse que je t'ai apportée juste avant ton dernier post ci-dessus... Merci de nous dire si ça te convient (et le cas échéant de solder le présent fil de discussion).

Cordialement,

Bonjour MDF , JCGL et à tous

Hier je n'ai pu répondre, un empêchement de dernière minute.
Donc je reprend à tête reposée.
merci MDF pour le code, je vais le tester et te tiens au courant.
sinon encore merci, j'ai bien retenu les commentaires, je vais en tenir compte.

Cordialement

Jean-Paul

Re bonjour MDF, JCGL et à tous

J'ai effectué différente manip

avec le programme
Sub CreerRaccourci()
'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
'Crée le raccourci sur le bureau Windows
Raccourci.TargetPath = .FullName
Raccourci.Save
Else
MsgBox "Sauvegardez déjà le classeur sur le DD et recommencez..."
End If
End With
End Sub

Celui-ci marche, mais il me donne l'icône d'excel avec le nom du programme

---------------------------------------
'======================================

Public Sub Raccourci()
Set wshshell = CreateObject("WScript.Shell")
strdesktop = wshshell.specialFolders("Desktop")
Utilisateur = Mid(strdesktop, 27, 8)
Set oshelllink = wshshell.createshortcut(strdesktop & "\Facture2.lnk") 'libellé du raccourci
oshelllink.targetPath = "c:\Factures\Facture2.xls" 'chemin du raccourci
oshelllink.WindowStyle = 1
oshelllink.HotKey = "CTRL+SHIFT+F" 'raccourci clavier
oshelllink.IconLocation = "c:\Facture2.ico" 'icône du raccourci
oshelllink.Description = "Cliquez ici Facture" 'Texte info-bulle du raccourci
oshelllink.WorkingDirectory = "c:" 'destination du raccourci
oshelllink.Save 'enregistre l'opération
End Sub

avec celui-ci
J'ai l'icône Windows que je remplace par mon icône.
mais ce n'est pas vraiment ce que je veux obtenir
'=======================================

Option Explicit

Sub CreerRaccourci()
'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 = "C:\Factures\Facture2.ico"
'Crée le raccourci sur le bureau Windows
.TargetPath = .FullName
.Save
End With
Else
MsgBox "Sauvegardez déjà le classeur sur le DD et recommencez..."
End If
End With
End Sub

j'ai l'impression que le .FullName est vide
Avec celui-ci il ne va pas au bout du programme j'ai une erreur

"La méthode 'Save' de l'objet 'IWshortcut' à échoué "
erreur d'exécution '-2147467259 (80004005)'


En vous remerciant par avance de vous penchez sur mon problème
dans une heure je serai absent alors ne vous inquiété pas.

Salutation à tous

Jean-Paul

Re bonjour à tous


Bonne nouvelle

Je viens de trouver la solution
le .FullName ne convient pas
j'ai affecté au path le chemin.

voici le programme modifié

Option Explicit

Sub CreerRaccourci()
'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 = "c:\Factures\Facture2.ico"
'Crée le raccourci sur le bureau Windows
.TargetPath = "c:\Factures\Facture2.xls" '.FullName
.Save
End With
Else
MsgBox "Sauvegardez déjà le classeur sur le DD et recommencez..."
End If
End With
End Sub


En vous remerciant mille fois

Cordialement
Jean-Paul

Bonsoir Carioca, JCGL, le Forum,

Tu as tout à fait raison Carioca, je me suis trompé dans le code que je présente plus haut, le .FullName ne convenait pas.

Il fallait écrire :

Le ActiveWorkbook fait toute la différence ici ! Il te permet notamment d'éviter de mettre le chemin "en dur" dans le code et si tu déplaces ton document, ce code fonctionnera toujours.

Désolé pour cette coquille.
(je corrige le code présenté plus haut)

Cordialement,

Bonjour MDF, JCGL et à tous

Effectivement, ça marche impeccable, je pensais que with précédent
le prenait en charge.

enfin tout marche bien et merci

A bientôt pour de nouvelles questions.
Salutation

Jean-Paul