إنشاء اختصار( بأيقونة محددة ) لملف العمل على الاكسل على سطح المكتب

[ابو تميم]

في الملف المرفق ملف اكسل داخل مجلد ومتضمن معه أيقونة محددة وتم أخذ اختصار لملف الاكسل وتم وضعه في نفس المجلد وتم تحديد الصورة المحددة أيقونة له

المطلوب هو عندما يتم تشغيل ملف الاكسل لأول مرة يتم تلقائيا إنشاء إختصار لملف العمل على سطح المكتب ( وهو الاختصار المعد مسبقا ذو الصورة المحددة ايقونة له )

وفي كل مرة يتم تشغيل البرنامج فيها يتم البحث عن اختصار البرنامج على سطح المكتب فإذا كان الاختصار موجود يتم إنهاء الكود وعدم إنشاء اختصار جديد وإذا كان الاختصار غير موجود يتم إنشاء الاختصار نفسه بنفس المطلوب أعلاه

شكرا لجهودكم

Icon.rar

[عبدالله باقشير]

السلام عليكم

هذا كود منقول

يعمل اختصار للملف على سطح المكتب

عدلت عليه ليكون تلقائي للملف النشط

قد يناسبك

تفضل الكود:

Sub CreateDesktopShortcut()

Dim objShell As Object, wsh As Object

Dim StrFilePath, newLnk, strDeskPath, strName

'''''''''''''''''''

StrFilePath = ThisWorkbook.FullName

''''''''''''''''''''

Set objShell = CreateObject("Shell.Application")

Set wsh = CreateObject("WScript.Shell")

'''''''''''''''''''''''''''

strDeskPath = objShell.Namespace(&H10&).Self.Path

strName = strDeskPath & "\Shortcut to " & ThisWorkbook.Name & ".lnk"

' ''''''''''''''''''''

Set newLnk = wsh.CreateShortcut(strName)

newLnk.TargetPath = StrFilePath

newLnk.Save


Set objShell = Nothing

Set wsh = Nothing

End Sub

[ابو تميم]

كود رهيب جدا وهو يعمل بشكل ممتاز

ولكن هل يمكننا التحكم فيه والتعديل عليه بحيث يمكن أن تكون الأيقونة مرتبطة بصورة معينة يتم حفظها في مجلد البرنامج ويكون ارتباط الاختصار بهذه الصورة إذا كان هذا ممكنا وإذا لم يكن ممكنا فلا ضير

شكرا جزيلا وجزاكم الله خيرا