yhq25

شكرا جزيلا للجميع 

واجهت نفس المشكلة وحذفت الأوفيس ونزلت نسخة أخرى من الأوفيس وتعرف على المعالج ومشى معي المعالج هذا احد الحلول

عندما اريد إضافة مكتبة   progress bar   يعطي رسالة  (( خادم  ole  غير مسجل )) بقيت هذه المشكلة فقط .

برنامج SETUP FACTORY  رائع وجميل ومعرب وفيه كل ما تريد وقد جربته وكان رائعا

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

Public Function yhy39impAllSheets()
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String, strTable As String
Dim db As DAO.Database
Dim tdf As DAO.TableDef
'Dim strPassword As String


'**********عملية الاستيراد  من بيانات جميع اوراق العمل في ملف اكسيلل الى جداول منفصلة************

'كود تفاعلي  لربط البيانات  من كل اوراق العمل من ملف اكسلل مفرد وكل بيانات ورقة ستربط بجدول منفصل باسم ورقة العمل
'(مثال'"Sheet1").

' تاسيس كائن لتطبيق الاكسلل
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
      Set objExcel = CreateObject("Excel.Application")
      blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

' غير الخطوة القادمة الى
'True لاظهار اسماء الاعمدة في الصف الاول في الاكسلل
blnHasFieldNames = False

''''''' غير المسار التالي الى المسار الذي تريده'''''''''
'strPathFile = "c:\myfile.xls"
strPathFile = Me.txtPath
'''''''''''''''''''''''''''''''''''''''''''''''''''

' استبدل password بكلمة المرور الحقيقية  ;
' اذا لم يكن هناك حاجة لكلمة المرور, استبدلها بـvbNullString constant
' (مثال, strPassword = vbNullString)

'strPassword = "passwordtext"


'strTable = "Sheet"

' = true  افتح ملف الاكسلل للقراءة فقط
blnReadOnly = True

' افتح ملف الاكسلل ثم اقرأ أسماء مجموعة اوراق العمل
Set colWorksheets = New Collection
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly)     ',,strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
      colWorksheets.Add objWorkbook.Worksheets(lngCount).name
Next lngCount

' اغلق ملف الاكسلل بدون حفظ, مع تنظيف كائنات إكسيل
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' استيراد البيانات من كل ورقة عمل الى جداول منفصلة
For lngCount = 1 To colWorksheets.Count Step 1
      DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, colWorksheets(lngCount), strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$"
Next lngCount

     'DoCmd.TransferSpreadsheet acLink, 8, strTable, strPathFile, False, colWorksheets(lngCount) & "$"

' حذف المجموعة
Set colWorksheets = Nothing
DoCmd.Rename sheet2, acDefault, CS_SchoolStudentsAlphabeticallyReport
Refresh
' قم بتفعيل  خطوة التعليمات البرمجية التالية إذا كنت تريد حذف ملف إكسيل بعد أن يتم استيراده

 'Kill strPathFile
'*************************************انتهت عملية الاستيراد*********************************


End Function

وهذا كود البحث بجزء من الاسم" 


Like "*" & [أدخل جزء من الحقل] & "*"

طلبك غير واضح والمثال كذلك

حدد طلبك بدقة وحدد الحقول المطلوب البحث فيها 

وحدد هل البحث كل نموذج على حدة ام كل النماذج ببحث واحد