اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

kanory

الخبراء
  • Posts

    2,293
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    138

kanory last won the day on أكتوبر 25 2024

kanory had the most liked content!

السمعه بالموقع

4,214 Excellent

عن العضو kanory

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    معلم

اخر الزوار

7,998 زياره للملف الشخصي
  1. ممكن الاستغناء عن إضافة المسارات في الجدول ويتم عرضها من المجلد مباشرة بمعرفة الرقم فقط
  2. اصنع زر في النموذج لديك ثم ادرج هذا الكود فيه ............... Dim db As DAO.Database Dim rs As DAO.Recordset Dim oldPicPath As String Dim newPicPath As String Dim FirstName As String Dim keyVal As String Dim desktopPath As String Dim sourceFolder As String Dim destFolder As String Dim fileSystem As Object desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") sourceFolder = desktopPath & "\555\Pic1\" ' المجلد المصدر destFolder = desktopPath & "\555\Pictures\" ' المجلد الوجهة Set fileSystem = CreateObject("Scripting.FileSystemObject") If Not fileSystem.FolderExists(destFolder) Then fileSystem.CreateFolder destFolder End If Set db = CurrentDb Set rs = db.OpenRecordset("Table1", dbOpenDynaset) Do While Not rs.EOF If IsNull(rs!Pic2) Or rs!Pic2 = "" Then FirstName = rs!FirstName keyVal = rs!Key If Not IsNull(FirstName) And Not IsNull(keyVal) Then oldPicPath = sourceFolder & FirstName & ".jpg" newPicPath = destFolder & keyVal & ".jpg" If fileSystem.FileExists(oldPicPath) Then fileSystem.MoveFile oldPicPath, newPicPath rs.Edit rs!Pic2 = newPicPath rs.Update End If End If End If rs.MoveNext Loop rs.Close Set rs = Nothing Set db = Nothing Set fileSystem = Nothing MsgBox "تم نقل الصور وتحديث الحقل Pic2 بنجاح", vbInformation
  3. وعليكم السلام ورحمة الله وبركاته لاحظ الشرح ثم استخدم هذا ................ Private Sub NEM_SH_NotInList(NewData As String, Response As Integer) Dim db As DAO.Database Dim rs As DAO.Recordset Dim MsgBoxResult As VbMsgBoxResult MsgBoxResult = MsgBox("العنصر '" & NewData & "' غير موجود. هل ترغب في إضافته؟", vbYesNo + vbQuestion, "إضافة عنصر جديد") If MsgBoxResult = vbYes Then Set db = CurrentDb Set rs = db.OpenRecordset("SH", dbOpenDynaset) NewID = Nz(DMax("ID_SH", "SH"), 0) + 1 rs.AddNew rs!ID_SH = NewID rs!ASASE = NewData rs.Update rs.Close Set rs = Nothing Set rs1 = Nothing Set db = Nothing Response = acDataErrAdded Else Response = acDataErrContinue End If End Sub
  4. مشاركة مع الاخوة .... هل الكود السابق الذي لديك تصدر التقرير ويطبع في نفس الوقت .... ام انت تطبع يدويا ... استخدم طريقة التصدير ثم الطباعة عن طريق الكود مباشرة دون تدخل منك
  5. طيب جرب التعديل الجديد ربما يعجبك ............. 1 (11).accdb
  6. تفضل اضغط دبل كليك على الحقل وعلمنا ..... 1 (11).accdb
  7. بارك الله فيك @MO87
  8. جرب هذا Dim searchText As String Dim fieldValue As String ' النص الذي تبحث عنه searchText = "Ca" ' أدخل الكلمة أو جزء الكلمة المراد البحث عنها fieldValue = Nz(Me!Field1, "") ' جلب القيمة من الحقل Field1 مع التعامل مع القيم الفارغة ' التحقق إذا كانت القيمة تحتوي على النص المطلوب If InStr(1, fieldValue, searchText, vbTextCompare) > 0 Then ' فتح النموذج Form1 إذا تحقق الشرط DoCmd.OpenForm "Form1" Else ' عرض رسالة توضيحية إذا لم يتحقق الشرط MsgBox "الحقل لا يحتوي على النص المطلوب.", vbInformation, "تحذير" End If
  9. لا يحتاج لاستئذان اخي الفاضل .. كل ما ينشر هو وقف للجميع بارك الله فيك
  10. استاذي الغالي الدروب بوكس ايضا تستطيع من خلاله قراءة النصوص .... جرب المرفق ووافني بالنتيجة .... KAN_1.accdb
  11. بارك الله فيك استاذي الفاضل @Foksh اشكرك على الشرح الوافي جزاك الله خير وكتب أجرك على ما تقدمة رحم الله والدك ووالدينا وجميع المسلمين الاحياء والاموات
  12. بارك الله فيك اخي الكريم على الطرح لكن هناك فكرة مشابهه لهذه الطريقة في المنتدى .... ما الجديد في موضوعك ... لاني عجزت اعرف الفارق البرمجي فيها
  13. اخي الكريم بارك الله فيك احسن الظن باخوانك اولا معظم مواضيع السابقة وجدت لها الحل من قبل الاعضاء الاكارم وعملت انت عليها عملية صح اذا كان هناك موضوع واحد لم تجد له الإجابة فأكيد وتأكد أن الإخوة الأعضاء مروا وشاهدوا ولم يستطيعوا فهم أو حل موضوعك والسبب بالإضافة لما ذكر اخي @ابوخليل انك لم تدرج سجلات للتجربة عليها
×
×
  • اضف...

Important Information