اضافة على الكود حتى يعمل مع كل الامتدادات

[فوزى فوزى]

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

ارشيف.rar

[محمد يوسف ابو يوسف]

اخي فوزى فوزى

هل تريد حفظ عدة نسخ  كل نسخة بامتدات المزكورة اعلي

بمعني- تريد نسخة -بي-دي-اف-ونسخة وورد-وهكذا

ام ماذا تريد ؟

[فوزى فوزى]

شكرا استاذ محمد يوسف على ردكم لى المطلوب عمل ارتباط تشعبى مع كل الامتدادت بمعنى اضافة على هذا الجزء من الكود لان الارتباط التشعبى  الموجود فى هذا الملف لايفتح الا الملفات بى دي اف واريد ان اعمم على الكود حتى يفتح صورة او ملف ورد او ملف اكسس او ملف اكسيل وهذا الجزء المطلوب التعديل عليه

stPath = ActiveWorkbook.Path & "\" & c.Value & ".pdf"

[عبدالفتاح في بي اكسيل]

لماذا  لا  تجعل  قائمة  الملفات  في  عمود  محدد   ومن ثم  عمل  هايبر لينك  وفتحها بدلا  من  كتابة  الملفات يدويا  في  العمود  الاول  وربطها  بعمود  اخر.

لا  اعتقد  انها  طريقة  عملية .  اراها  تاخذ  الكثير  من  الوقت  لتربط  كل  ملف  تكتبه  يدويا  بعمود أخر .

[فوزى فوزى]

الف شكر استاذ عبدالفتاح على الرد الكود الموجود فى الشيت جميل ويعمل مع الملفات بى دى اف نريد اضافة على الكود ليعمل مع امتداد الصور او ملفات الورد او الاكسيل

[عبدالفتاح في بي اكسيل]

@فوزى فوزى  لم  تجيني  على  استفساري  

لا  اجد  اي  مبرر  لهذه  الطريقة  انت  تصعب  الامور  على  نفسك  وعلينا .

مع  هذا  هذه  محاولة  اذا  لم  يكن  ما  تريده  عليك  انتظار  شخص  اخر.

index.xlsm

[خالد الشاعر]

Option Explicit
 Sub addHyperlinks()
 Dim objFSO As Object
 Dim objFolder As Object
 Dim objFile As Object
 Dim i As Integer
 Dim dataSheet As Worksheet
   Set dataSheet = ورقة1
   'Create an instance of the FileSystemObject
 Set objFSO = CreateObject("Scripting.FileSystemObject")
   'Get the folder object
 Set objFolder = objFSO.GetFolder("C:\Users\Khaled\Desktop\ارشيف")
    i = 1
   'Loop through each file in the folder
 For Each objFile In objFolder.Files
   dataSheet.Hyperlinks.Add Anchor:=Cells(i, 5), Address:=objFile.Path, TextToDisplay:=objFile.Name, ScreenTip:=objFile.Path
 i = i + 1
   Next objFile
 End Sub

جرب هذا الكود وهو منقول من موقع اجنبي

[فوزى فوزى]

استاذ عبدالفتاح فى بى اكسيل استاذ خالد الشاعر اسطر اعجابى بكم وجميع من فى المنتدى الصرح التعليمى العظيم شكرا جزيلا على هذا المجهود وما اشعر به من امتنان لكل من ساعدنى