سؤال فى الارتباط التشعبى

[الحســـام]

بسم الله الرحمن الرحيم

الاخوة الافاضل والاساتذة الكرام .....

هل من الممكن ادراج ارتباط تشعبى فى ملف اكسيل لعدد كبير من الملفات دفعة واحدة على ان يكون ارتباط كل ملف هو اسم الملف نفسة فى خلية ؟

جزاكم الله خيرأ

[الـعيدروس]

السلام عليكم

ممكن أخي حسام

أرجو منك أرفاق مثال ملف اكسل

وبه أسماء الملفات ومسارها

واذا كانت الملفات في نفس فولدرالملف نكتفي بأسمائها فقط

[الحســـام]

شكرا ااستاذ ابو نصار على الاهتمام

ولكن عدد الملفات كبيرة جدا وهى من نوع jpg مستندات سحبتها على مدار اعوام بالاسكانر

واريد ترتيبها وفهرستهاعن طريق الاكسيل والارتباط التشعبى وهى فى نفس الفولدر

(وللتوضيح) اريد ان يتم ادراجهم جميع دفعة واحدة لورقة الاكسيل

[الـعيدروس]

السلام عليكم

هذا الكود في حدث الورقة

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("A:A")) Is Nothing Then

Path_A = ThisWorkbook.Path & "\"

S_F = ActiveCell.Text

Ali_Exec 0, "OPEN", Path_A & S_F, "", Path_A, 1

Cancel = True

End If

End Sub

وهذه الأكواد في مودويل

Public Declare Function Ali_Exec Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Function Ali_List(F_A As String, Optional Fltr_A As String = "*.jpg") As Variant

	    Dim Te_A As String, A_H As String

	    If Right$(F_A, 1) <> "\" Then F_A = F_A & "\"

	    Te_A = Dir(F_A & Fltr_A)

	    If Te_A = "" Then

			    Ali_List = False

			    Exit Function

	    End If

	    Do

		 A_H = Dir

		 If A_H = "" Then Exit Do

		 Te_A = Te_A & "|" & A_H

		 Loop

	    Ali_List = Split(Te_A, "|")

End Function

Public Sub Ali_Imag()

Dim Path_F$

Path_F = ThisWorkbook.Path

  M_v = Ali_List(Path_F)

   x = 2

    If TypeName(M_v) <> "Boolean" Then

	  For i = LBound(M_v) To UBound(M_v)

	  Cells(x, 1) = M_v(i)

	  x = x + 1

	  Next

    End If

End Sub

ستجد زر في المرفق

بعد النقر عليه ستظهر اسماء الصور في العمود "A"

أنقر مرتين على الصوره المراد فتحها

هذه طريقة أفضل من الأرتباط التشعبي

لان الارتباط التشعبي بطيء نوع ما

أرجو أن هذه الطريقة تلبي الطلب

Ali_Imag.rar

[الحســـام]

جزاك الله خيرا اخى ابو نصار وجار التجربة وساخبرك بالنتيجة

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل أبا نصار حفظكم الله

جزاكم الله كل خير وبارك لكم في صحتكم وعافيتكم وعلمكم ورزقكم.

فقط لقد غيرت أمتداد الملفات إلى Xls في الكود وجلب لي أسماء ملفات الأكسيل ولكن عند النقر دبل كليك على الأسم لا يفتح الملف مع العلم أن الصور تفتح بدون مشكلة على المتصفح.

ما هو التغيير المطلوب في الكود كي يتم فتح الملفات بشكل عام أن كانت أكسيل أو ورد ......؟

تقبل فائق التقدير والأحترام

أبو أنس

[الـعيدروس]

السلام عليكم

اخي انس حاجب

اذهب للمدويل وغير الامتداد كالتالي

Public Function Ali_List(F_A As String, Optional Fltr_A As String = "*.xls") As Variant

وكود حدث الورقة بيكون بهذا الشكل

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("A:A")) Is Nothing Then

S_F = ActiveCell.Text

Path_A = ThisWorkbook.Path & "\" & S_F

'Path_A = "C:\A" ' اذا كان مسار

Workbooks.Open Path_A

'Ali_Exec 0, "OPEN", Path_A & S_F, "", Path_A, 1

Cancel = True

End If

End Sub

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل أبا نصار حفظكم الله

نور الله بصركم وبصيرتكم بنور الأيمان والعلم والمعرفة.

تقبل كل الأحترام والشكر والتقدير.

أبو أنس

[ايهاب سعيد]

عفوا استاذتي لكن هناك ملف بالاكسل اعتقد انه المطلوب حيث يقوم باعداد ملف بالاكسل مع ارتباط للملفات جربه وبلغني

Indexer 1%2e2 2010.rar

[الحســـام]

شكرا لجميع الاساتذة (الاستاذ ابو نصار واستاذ ايهاب ) وشكرا الاستاذ ابو انس على المشاركة فقد قامت ملفاتكم بالعمل على اكمل وجه - وهذا البرنامج وجدتة على الانترنت مفيد فى الارشفة الالكترونية وهو مجانى وحجمة 27 ميجا تقريبا ويمكن الاستفادة منه بأفكار جديدة ااسم البرنامج eDoc Organizer وسوف احاول رفعة على احد مواقع الرفع وجزاكم الله كل خير وهداكم الى ما يحبه ويراضاه