Display logo pasted to worksheet as icon on desktop shortcut

[Salome]

I know this topic has been raised a million times, but I have not come
across a solution that works or maybe I have just not noticed it.
:banghead: :banghead:
I have already converted my image as an Icon and inserted it as an object
onto a hidden sheet of my workbook. I have found a good way in order to
create the desktop shortcut via vba. All I now need to be able to do is to
have the saved object's face to be displayed as an Icon on my desktop
shortcut. I don't have any idea. Please any suggestion would be welcome.
Thank you.

[Rob342]

Salmone

All i would do is paste the icon to the desktop then change the properties
Works for me on EXE file.

General change to application
Target, set to where the file is
Start in, the drive & folder name

[Salome]

Hi Rob342
Thank you very much for your reply.

Although I have been at this "most" difficult task for some time, I have eventually managed a GOOD solution to this.

After copying, pasting, cutting and modifying code from VARIOUS sites all over the Net, I can honestly say that I have found EXACTLY what I was looking for. And it works WONDERFULLY!

If it could help others, I am attaching the worksheet and complete code. This works in ALL versions of Excel since 2000 to current. I am sure others would benefit from it too.

Have a great day.

Regards
Salomé:bow: :bow: :bow:

[Rob342]

Hi Salmone
Thanks for posting the workbook back, it helps others should the need arise.

Rob

ps can you mark thread as solved.

[Salome]

Hi Rob342

No problem at all. If It could help anyone, It would be worth my effort...

Thank you to all the responses I received with regards to my question.:friends:

[Salome]

Hi Rob342

Just a stupid question.

I received a message from someone asking me why the workbook's macro is not enabled even though they hit the commandbutton. Did I maybe loaded it the incorrect format? I am still a greenie at this forum thing. Please could you assist?

Thank you very much.:dunno

[Rob342]

Salmone

It works for me but,

The button you have is not a "Command Button" as such, you need to create the correct command button active X control and then assign your code to work with it, otherwise you might have to run it from the macro.

Rob

[Kenneth Hobs]

You used a form control button which is fine. The user's problem may be that they have their security set at High or they chose not to click the Enable Macros button for a medium security. In Excel 2007+, it is fairly obvious that macros should be enabled for an xlsm file. For an xls file, some users never want macros enabled.

When a spreadsheet must have macros enabled, some hide their sheets by code when it closes except for an informative sheet. Obviously, you need it password protected in that scenario as well. When macros are enabled, the Open event is coded to unhide the sheets and unprotect as needed.

The icon was not created for me but the shortcut was when the file was opened in my temp folder. When I saved the file, deleted the shortcut, clicking the button did nothing.

If you will restructure your code for the IF() loops, I think that you will see why the 2nd run does not work. It is because "C:\Desktop Shortcut" path already exists so it does nothing. I see no reason for the Else. If you explain in words what it should do, I could fix it for you. e.g. Put on Desktop if desktop path is found. If desktop path does not exist, create "C:\Desktop Shortcut" path. And so on...

I think the structure for the code without your Else would be:

Sub Desktop_Shortcut()
Dim WBName As String, Path As String, WB_Link As String, WB_Name As String
Dim DesktopPath As String, TargetPath As String, StrSave As String
Dim WSHShell As Object, MyShortcut As Object
Set WSHShell = CreateObject("WScript.Shell")
Dim FSO As Object, Folder As Object, File As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim WB As Workbook
Set WB = ThisWorkbook
Dim WSh As Worksheet
Set WSh = Sheet1
WBName = WB.Name
Path = "MyFile"
DesktopPath = WSHShell.SpecialFolders("Desktop")
WSh.Range("C2").Value = WB.Name
WB_Name = WSh.Range("C3").Value
WB_Link = WSh.Range("C4").Value
On Error GoTo ErrHandle
If Not DirExists("C:\" & WB_Name) Then 'Check C Drive
If Not DirExists(GetSpecialFolder(CSIDL_PERSONAL) & "\" & WB_Name) Then 'Check My Documents
Set FSO = CreateObject("Scripting.FileSystemObject") 'If not in C Drive or My Documents - then create shortcut
FSO.CreateFolder "C:\" & WB_Name
ChDir "C:\" & WB_Name
SavePicture Sheet1.Image1.Picture, WB_Name & ".ico" 'Picture pasted onto Image1 on Sheet 1 - Link Shortcut
Set FSO = CreateObject("Scripting.FileSystemObject")
Set MyShortcut = WSHShell.CreateShortcut(DesktopPath & "\" & WB_Link)
With MyShortcut
.TargetPath = WB.FullName
.IconLocation = "C:\" & WB_Name & "\" & WB_Name & ".ico"
.WindowStyle = 1
.Description = "EEZIAdmin"
.WorkingDirectory = WB.Path
.Save
End With
End If
End If
ErrHandle:
Set WSHShell = Nothing
End Sub