ابو البشر

اولا : بارك الله فيك استاذي @Foksh الذي كنت سببا في قدح الفكرة في رأسنا وحاول الطالب مجارات المعلم ثانيا : سامحني على اقتباس الفكرة والبرمجة على اساسها ثالثا: اضفت بعض الاضافات :::::::::::: * نقل الملفات من مجلد الى اخر * اعادة تسمية الملفات * حذف الملف * يمكن تحديد المجلد للرفع له * تصفية ملفات المجلد فقط * مجرد اختيار الملف في قائمة ملفات قوقل يظهر رابط التحميل بثلاث طرق 1- تحميل الملفات الصغيرة 2- تحميل الملفات الكبيرة 3- عرض الملف في المتصفح * هناك تعديلات قائمة ........

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

اولا : غفر الله لوالدك ووالدينا واللهم ارحمه، ووسّع نزله، وأكرم مدخله، ثانيا عمل غاية الابداع ولك الشكر على ذلك ... بارك الله فيك ثالثا : استخدمت النسخة 32 bit لم تظهر لدي المجلدات ولا يتم تكوين مجلد رابعا : بالنسبة للملفات ذات التسمية العربية لا يرفعها بنفس الاسم وتجد الملف فقط بالامتداد الخاص بها بدون اسم وهل نري قريبا اختيار متعدد للملفات ليتم رفعها دفعة واحدة خامسا : طلب وليس امر ان حققته فهذا كرم منك والا فهو اقل حقوقك ... لو امكن شرح لطريقة البرمجة التي اتبعتها .... جزاك الله خيرا

كرري التحديث للنماذج الثلاث Private Sub n1_Change() [Form1].Requery [Form2].Requery [Form3].Requery End Sub

وهذه طريقة اخرى .... Database1 (33).accdb

تفضل Database1 (33).accdb

جرب هذا ........................ Sub CleanAndRemovePatterns() Dim db As DAO.Database Dim rs As DAO.Recordset Dim strPattern As String Dim strInput As String Dim updatedText As String Dim regExp As Object On Error GoTo ErrorHandler Set db = CurrentDb Set rs = db.OpenRecordset("SELECT ID, nass FROM book", dbOpenDynaset) strPattern = "&\d+&&" Set regExp = CreateObject("VBScript.RegExp") regExp.Pattern = strPattern regExp.Global = True Do While Not rs.EOF If Not IsNull(rs!nass) Then strInput = rs!nass updatedText = strInput If regExp.Test(updatedText) Then updatedText = regExp.Replace(updatedText, "") End If If Left(updatedText, 2) = vbCrLf Then updatedText = Mid(updatedText, 3) ElseIf Left(updatedText, 1) = vbLf Then updatedText = Mid(updatedText, 2) ElseIf Left(updatedText, 1) = vbCr Then updatedText = Mid(updatedText, 2) End If updatedText = LTrim(updatedText) If strInput <> updatedText Then rs.Edit rs!nass = updatedText rs.Update End If End If rs.MoveNext Loop rs.Close Set rs = Nothing Set db = Nothing Set regExp = Nothing MsgBox "تمت إزالة الأنماط والسطر الفارغ بنجاح!", vbInformation Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical If Not rs Is Nothing Then rs.Close Set rs = Nothing End If Set db = Nothing Set regExp = Nothing End Sub

تفضل ..... الكود لنقل الرقم فقط ...اعلمنا بالنتيجة .... Sub ExtractSingleNumber() Dim db As DAO.Database Dim rs As DAO.Recordset Dim strPattern As String Dim strInput As String Dim regExp As Object Dim matches As Object ' النمط لاستخراج الرقم بين & و && strPattern = "&(\d+)&&" ' تهيئة قاعدة البيانات Set db = CurrentDb Set rs = db.OpenRecordset("SELECT nass, page FROM book") ' تهيئة كائن التعبير النمطي Set regExp = CreateObject("VBScript.RegExp") regExp.Pattern = strPattern regExp.Global = False ' المرور عبر السجلات Do While Not rs.EOF strInput = rs!nass If regExp.Test(strInput) Then Set matches = regExp.Execute(strInput) rs.Edit rs!Page = matches(0).SubMatches(0) ' الرقم المستخرج rs.Update End If rs.MoveNext Loop ' تنظيف الموارد rs.Close Set rs = Nothing Set db = Nothing Set regExp = Nothing MsgBox "تم نسخ الأرقام إلى الحقل page بنجاح!" End Sub والكود التالي لحذف السطر الذي به النمط تفضل ...... Sub RemoveAllPatterns() Dim db As DAO.Database Dim rs As DAO.Recordset Dim strPattern As String Dim strInput As String Dim regExp As Object ' النمط لإزالة كل ما يشبه &رقم&& strPattern = "&\d+&&" ' تهيئة قاعدة البيانات Set db = CurrentDb Set rs = db.OpenRecordset("SELECT nass FROM book") ' تهيئة كائن التعبير النمطي Set regExp = CreateObject("VBScript.RegExp") regExp.Pattern = strPattern regExp.Global = True ' لضمان إزالة جميع التطابقات داخل النص ' المرور عبر السجلات Do While Not rs.EOF strInput = rs!nass If regExp.Test(strInput) Then rs.Edit ' إزالة جميع التطابقات للنمط من النص rs!nass = regExp.Replace(strInput, "") rs.Update End If rs.MoveNext Loop ' تنظيف الموارد rs.Close Set rs = Nothing Set db = Nothing Set regExp = Nothing MsgBox "تم حذف جميع الأنماط &رقم&& بنجاح!" End Sub

جرب هذا .... On Error Resume Next Dim s As String s = InputBox("ادخل الرقم القومي المكون من 14 رقم", "ابدا البحث من فضلك") If s <> "" Then ' تطبيق الفلتر Me.Filter = "IDNumber = '" & s & "'" Me.FilterOn = True Else MsgBox "الرجاء إدخال الرقم القومي.", vbExclamation, "خطأ" End If

بارك الله فيك اخي الكريم .. مايحتاج استئذان ...

مساءك فل .... ممكن الشكل المتوقع تصديرة .... هل تريد كل سائق وامامه بياناته ومع الاصول التي تخصه ... يعني مثلا سائق لديه ثلاث سيارات اصول ... هل تريدها في ثلاث سجلات ... ام سجلات مدمجة ؟؟؟؟

طيب ... الان افرد الطلب الثاني ( تصدير البيانات الى اكسل ) في موضوع مستقل ... بارك الله فيك

لاحظ الفرق بين الادخال الصحيح وادخالك انت !!!!

هذه بضاعتكم ردت اليكم وانا لم ادخل بيانات ولاكن تعاملت مع الموجود في الجدول اساسا .... تأكد من ادخالاتك في الجدول ... لانك انت من ادخلت التواريخ والاسابيع ... وليس للغة البرمجة في شيئ

هل هذا ما تريد ..... تغيير رقم الاسبوع ليبدا من 1.accdb