إستدعاء بيانات من ملفات مغلقة

[أبو حنــــين]

هذا المثال يبين طريقة استدعاء بيانات من عدة ملفات مغلقة أردت طرحه بطريقة مبسطة لتعم الفائدة

استدعاء بيانات.rar

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

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

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

جزاكم الله كل خير على إشاعة العلم والمعرفة وبارك الله لكم وفيكم وفي ذريتكم من بعدكم بعد عمر مديد إن شاء الله كي ينتفع بعلمكم وزادكم الله علماً على علم ووسع أبواب رزقكم.

أبو أنس

[أبو محمد عباس]

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

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

اخي العزيز تظهر عندي رسالة خطا بالكود عندما اقوم باستدعاء البيانات

Private Sub CommandButton1_Click()

UserForm1.Show

End Sub

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

[منياوى]

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

[أبو حنــــين]

أخي الحبيب : أبو أنس حاجب

أخي الحبيب : عباس السماوي

أخي الكريم : Jo11

جزاكم الله خيرا على المرور و الكلمات الطيبة

أخي عباس المثال يعمل عندي بطريقة صحيحة ربما الخطأ من عندك

[ابو تميم]

أخي أبو حنين

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

الملف عندي أيضا يعطي خطأ بنفس الخطأ الوارد في المشاركة رقم 3

أنا أعمل على أوفيس 2007 وأوفيس 2010 وكل منها على جهاز مختلف والخطأ نفسه

ربما ملفك يعمل على اوفيس 2003 فقط

نرجو التكرم التأكد من الكود وجزاكم الله خيرا

[الجزيرة]

بارك الله فيك أخي ابو حنين ( حفظها الله )

نفس مشكلة الأخوين عباس و ابو تميم

اوفيس 2007

[الـعيدروس]

السلام عليكم

بعد اذن الاستاذ الحبيب ابو حنين

تم عمل معادله بدلا من امر " FileSearch" هو الذي يحدث الخطاء

و تعديل بسيط على اكواد حدث "ComboBox1 "

هذه الاكواد وعليها التعديل

Dim xl As New Excel.Application

Dim xlw As Excel.Workbook

Dim S_tv$

Private Sub ComboBox1_Click()

If ComboBox1.ListIndex = 0 Then

MsgBox "هذا الملف رئيسي لا يحتوي على معلومات يرجى اختيار ملف آخر", vbExclamation, "خظأ"

Exit Sub

End If

ComboBox2.Clear

S_tv = ThisWorkbook.Path & "\" & ComboBox1.Text

Set xlw = Workbooks.Open(S_tv)

LR = xlw.Application.Cells(Rows.Count, "A").End(xlUp).Row '+ 1

For t = 2 To LR

ComboBox2.AddItem xlw.Application.Cells(t, 1)

Next

xlw.Close

End Sub

Private Sub ComboBox2_Click()

Set xlw = xl.Workbooks.Open(S_tv)

For s = 1 To 8

Me.Controls("TextBox" & s) = xlw.Application.Cells(Val(ComboBox2.Text) + 1, s).Value

Me.Controls("Label" & s).Caption = xlw.Application.Cells(1, s)

Next

xlw.Close

End Sub

Private Sub UserForm_Initialize()

Ali_FileSearch

End Sub

Private Sub Ali_FileSearch()

Dim Path_F$

Path_F = ThisWorkbook.Path

    M_v = Ali_List(Path_F)

    If TypeName(M_v) <> "Boolean" Then

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

		    ComboBox1.AddItem M_v(i)

	    Next

    Else

		 MsgBox "لاتوجد ملفات في المسار :" & Path_F

    End If

End Sub

Public Function Ali_List(F_A As String, Optional Fltr_A As String = "*.*") 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

استدعاء بيانات_A.rar

[hdish]

عزيزى

بعد التحية

واجهتنى نفس المشكلة ولكن بعد عمل دوبل كليمك على الفورم يظهر لك الكود حتلاقيه بيتكلم عن UserForm حضرتك مشكورا غيره ل UserForm1 وإن شاء الله ح تشتغل

[أبو حنــــين]

في الواقع انا اعمل على النسخة 2003 و لا ادي مالذي يحث في النسخ ما بعد 2003

و اعتقد اني اخي الحبيب أبو نصار قد أصلح الخطأ

و الله اعلم

تحياتي للجميع على المرور

[أبو أنس80]

شكرا جزیلا