Masa üstünde icon yaratmak

[TİKOS]

Üstatlar, hazırlamış olduğum macroyu excelden değilde masa üstünde
yaratılmış bir icondan açmak istiyorum. Bu konuda yardımlarınızı rica ediyorum.
Teşekkürler

 

[efsane81]

örnek dsya koyarsan sevinirim

 

[efsane81]

Sub Dektop_Icon_anlegen()
Call DShortCut(ThisWorkbook.FullName)
End Sub
Function DShortCut(strFullFilePathName As String) As Long
Dim WSHShell As Object
Dim WSHShortcut As Object
Dim strDesktopPath As String
Dim strFileName As String
Dim strPath As String

On Error GoTo ErrHandler

' Create a Windows Shell Object
Set WSHShell = CreateObject("wscript.Shell")

' Get the file's name and path...
strFileName = Dir(strFullFilePathName)
strPath = Left(strFullFilePathName, Len(strFullFilePathName) - Len(strFileName))

' Make sure file exists
If Not Len(strFileName) = 0 Then

' Read desktop path using WshSpecialFolders object
strDesktopPath = WSHShell.SpecialFolders.Item("Desktop")

' Create a shortcut object on the desktop
Set WSHShortcut = WSHShell.CreateShortcut(strDesktopPath & "\" & strFileName & ".lnk")

' Set shortcut object properties and save it
With WSHShortcut
.TargetPath = WSHShell.ExpandEnvironmentStrings(strFullFilePathName)
.WorkingDirectory = WSHShell.ExpandEnvironmentStrings(strPath)
.WindowStyle = 4
.IconLocation = WSHShell.ExpandEnvironmentStrings(Application.Path & "\excel.exe , 0")
.Save
End With
DShortCut = 1
Else
DShortCut = 0
End If

Continue:
Set WSHShell = Nothing
Exit Function

ErrHandler:
DShortCut = -1
Resume Continue
End Function

alıntıdır
kendine göre uyarlamalarını yapa bilirsin umarım aradığın budur. masa üstüne icon atıyor ve excell dosyanı oradan çağırıyorsun.

 

[TİKOS]

dosya ekte teşekkürler

 

[efsane81]

sayın tikos ekteki dosyayı inceleyin. kendinize göre uyarlayın. kolay gelsin