كيفية ربط ازرار في فورم لفتح ملفات اخري حتي لو مخفاه

[حمادة عمر]

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

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

مرفق ملف به عدد 13 ملف اكسيل منهم ملف ( فتح ) وهو الملف الرئيسي وعند فتحه يظهر فورم به عدد 12 زرار

المطلوب كيفية ربط هذه الازرار الـ 12 كل منهم بالملف صاحب اسمه في نفس المجلد وذلك في الحالات الآتيه :

** عندما تكون هذه الملفات في اي مكان علي الجهاز ( اي بارتيشن )

** عندما تكون الملفات الـ 12 مخفيه ( اي يكون بالمجلد الملف الرئيسي فقط هو الذي يظهر والباقي مخفي )

** عند فتح اي ملف من الزر الخاص به يعمل الاكسيل علي غلق الملف الرئيسي

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

فتح.rar

[حمادة عمر]

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

اعرف مدي مشغولياتكم ... ولكن علي قدر ما استطعتم ارجو الرد

في انتظار الروائع من سيادتكم وكل الشكر لمنتدانا الرائع واساتذته

وخصوصا استاذ الجميع عبد الله باقشير الذي تعلمت منه الكثير

جزاه الله عنا خيرا

[حمادة عمر]

رجاء الرد حتي لو جزء جزء ( ملحوظة ... اقصد بان يفتح الملف علي اي بارتيشين ان المجلد بالكامل علي d او e او f )

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

[حمادة عمر]

للرفع

[الـعيدروس]

السلام عليكم

الاخ الفاضل حمادة عمر

توصلت لحل يفي بالغرض

المشكله هيا الإنتظارفقط

لانه الكود بيبحث في جمي ملفات القرص بيأخذ حبتين من الوقت

تنسخ الأكواد لحدث الفورم طبعاً

حط اسم القرص ونوع الاكسل في اول الكود

Private Const Path_A As String = "C:\"

Private Const Fr_A As String = ".xls"

وهذا الكود

Private Const Path_A As String = "C:\"

Private Const Fr_A As String = ".xls"

Dim W_a As Workbook

Dim F_A As Object

Dim A_F As Object

Dim Rw As Long, Ar() As Variant

Private Function Ali_Dir(Nm_Comn As String)

Dim Nm_F$

Dim N_d As Long, N_f As Long, Siz_A As Currency

On Error Resume Next

Set F_A = CreateObject("Scripting.FileSystemObject")

With Application

.Calculation = xlCalculationManual

.ScreenUpdating = False

.EnableEvents = False

ReDim Ar(1 To 1000, 1 To 1)

Rw = 1

	 Nm_F = Nm_Comn & Fr_A

	 Siz_A = Find_A(Path_A, Nm_F, N_d, N_f)

		 If Str(nFiles) = "" Then MsgBox "لايوجد الملف المعني في القرص", vbExclamation, "تنبية !": Exit Function

		 If Str(nFiles) > 1 Then MsgBox "يوجد أكثر من ملف بنفس الاسم في القرص", vbExclamation, "تنبية !": Exit Function

	 ' MsgBox Str(N_d) & " عدد الملف المسماه بنفس الاسم" & Str(N_f) & " في الدليل", vbInformation

	 Cells(1, 205).Resize(1000, 1).Value = Ar

	 Ali_Dir = Cells(1, 205).Text

.EnableEvents = True

.ScreenUpdating = True

.Calculation = xlCalculationAutomatic

End With

Erase Ar

Set F_A = Nothing: Set A_F = Nothing

End Function

Private Function Find_A(ByVal S_F As String, SF_i As String, N_d As Long, N_f As Long) As Currency

Dim T_f As Object, Fil_N As String, T_Fi As Object

On Error GoTo Ex_A

Set A_F = F_A.GetFolder(S_F)

Fil_N = Dir(F_A.BuildPath(A_F.Path, SF_i), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)

While Len(Fil_N) <> 0

	 Find_A = Find_A + FileLen(F_A.BuildPath(A_F.Path, Fil_N))

	 N_f = N_f + 1

	 Ar(Rw, 1) = F_A.BuildPath(A_F.Path, Fil_N)

	 Rw = Rw + 1

	 Fil_N = Dir()

	 DoEvents

Wend

N_d = N_d + 1

If A_F.SubFolders.Count > 0 Then

	 For Each T_f In A_F.SubFolders

	 DoEvents

	 Find_A = Find_A + Find_A(T_f.Path, SF_i, N_d, N_f)

	 Next

End If

Exit Function

Ex_A: Fil_N = ""

Resume Next

End Function

ويستعدى من حدث الزر فرضا الزر هو CommandButton3 بيكون بالشكل التالي

Private Sub CommandButton3_Click()

Set W_a = Workbooks.Open(Ali_Dir(CommandButton3.Caption))

Unload Me

End Sub

ملاحظة مهمه:

قبل النقر على الزر أولا قم بالدخول للملف المسمى فتح

ثم استدعي الفورم وحاول تفتح أي ملف بعد استدعاء الدالة من كل زر

طبعا الكود يفتح الملفات المخفيه

والمرفق مطبق الكود على كل زر

أرجو التجربه وأي ملاحظه أو تعديل أنا موجود

تحياتي

فتح.rar

تم تعديل ديسمبر 18, 2012 بواسطه عباد

[حمادة عمر]

السلام عليكم

الاستاذ القدير عباد ابونصار

جزاك الله خيرا وآسف علي الاستعجال ولكن لاهميته لدي

وسيتم تجربة الكود واخبار سيادتكم بالنتيجة مع اني اعلم انها اكيد راااائعة ان شاء الله

شكرا جزيلا

[حمادة عمر]

السلام عليكم

الاستاذ القدير / عباد

كود فعلاً رااااااااااااااااااائع وجميل ويعمل بكفاءة وهذا ماريده بالضبط ولكن دون ان اثقل عليكم لي طلبان

** انه بمجرد الضغط علي زر اسم الملف وليكن CommandButton3 ليفتح الملف رقم 3 يقوم الكود تلقائياً

باغلاق الملف الرئيسي المسمي ( فتح ) ليصبح الملف الوحيد المفتوح هو الملف رقم 3

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

هل من الممكن الضغط علي الزر المراد فتحه من علي الفورم في بداية فتح الملف دون الحاجة للدخول للملف للضغط علي الزر الاصفر ( ان امكن )

وشاكر لسيادتك وللمنتدي كل ما تفيدونا به من حلول ومعلومات دائما ... جزاكم الله عنا خيرا

[الـعيدروس]

السلام عليكم

اشكرك على كلامك الطيب والمشجع

جرب المرفق

فتح_A.rar

[حمادة عمر]

السلام عليكم

الاستاذ القدير / عباد

اشكر لسيادتكم حسن التعاون وسرعة الاستجابة والكلام الطيب ليس قدرك انت واساتذة هذا المنتدي العظيم

فوالله لا اجد سوي كلمة ( جزاكم الله خيراً ) لتوفيكم حقكم

الكود تمام تمام ورااائع وسوف اضعه علي ملف العمل لدي وابلغ سيادتكم

[الـعيدروس]

الحمد لله الذي بنعمته تتم الصالحات