Moosak

إضافة للكود الذي تفضلت به أخي ABOLO2 في الموضوع الآخر .. ستجد في هذا الموضوع دالة تفضل بها المهندس العزيز @jjafferr تقوم بنفس العملية ولكن يجمع لك السنوات والشهور في سطر واحد .. ولكن بعدها يمكنك فصل السنوات والشهور والأيام بدالة Split كما وضح الأستاذ جعفر : 🙂

بعد إذن أستاذنا جعفر 🙂 تضعها في حدث عند عدم وجود بيانات أو On No Data للتقرير.

شكرا لك أخي @ABOLO2 🙂 على هذا المجهود الطيب .. ملاحظة : جرب استخدام هذا الخيار من لوحة التنسيق لإرفاق الأكواد : وستظهر لك بهذه الطريقة المنظمة والجميلة 🙂 : Sub test() 'و هذه هي طريقة الاستدعاء Debug.Print DatDiffY(#1/1/2020#, Date) ' السنوات Debug.Print DatDiffM(#1/1/2020#, Date) ' الأشهر Debug.Print DatDiffD(#1/1/2020#, Date) ' الأيام End Sub Function DatDiffY(Vdate1 As Date, Vdate2 As Date) As Integer Dim year1 As Integer Dim year2 As Integer Dim year3 As Integer Dim month1 As Integer Dim month2 As Integer Dim month3 As Integer Dim day1 As Integer Dim day2 As Integer year1 = Int(DatePart("yyyy", Vdate1)) year2 = Int(DatePart("yyyy", Vdate2)) month1 = Int(DatePart("m", Vdate1)) month2 = Int(DatePart("m", Vdate2)) day1 = Int(DatePart("d", Vdate1)) day2 = Int(DatePart("d", Vdate2)) If month2 < month1 Or day2 < day1 Then If (year2 - year1) - 1 < 0 Then DatDiffY = 0 Else DatDiffY = (year2 - year1) - 1 End If Else DatDiffY = year2 - year1 End If End Function Function DatDiffM(Vdate1 As Date, Vdate2 As Date) As Integer Dim day1 As Integer Dim day2 As Integer Dim month1 As Integer Dim month2 As Integer Dim month3 As Integer Dim year1 As Integer Dim year2 As Integer Dim dateC1 As Date day1 = Int(DatePart("d", Vdate1)) day2 = Int(DatePart("d", Vdate2)) month1 = Int(DatePart("m", Vdate1)) month2 = Int(DatePart("m", Vdate2)) year1 = Int(DatePart("yyyy", Vdate1)) year2 = Int(DatePart("yyyy", Vdate2)) If month2 < month1 Or day2 < day1 Then If month2 < month1 And day2 > day1 Then month3 = month2 + 12 DatDiffM = (month3 - month1) End If If month2 < month1 And day2 < day1 Then month3 = (month2 + 12) - 1 If (month3 - month1) - 1 < 0 Then DatDiffM = 0 Else DatDiffM = (month3 - month1) End If End If If month2 > month1 And day2 < day1 Then DatDiffM = (month2 - month1) - 1 End If Else DatDiffM = month2 - month1 End If End Function Function DatDiffD(Vdate1 As Date, Vdate2 As Date) As Integer Dim day1 As Integer Dim day2 As Integer Dim month1 As Integer Dim month2 As Integer Dim month3 As Integer Dim year1 As Integer Dim year2 As Integer Dim year3 As Integer Dim dateC1 As Date day1 = Int(DatePart("d", Vdate1)) day2 = Int(DatePart("d", Vdate2)) month1 = Int(DatePart("m", Vdate1)) month2 = Int(DatePart("m", Vdate2)) year1 = Int(DatePart("yyyy", Vdate1)) year2 = Int(DatePart("yyyy", Vdate2)) If day2 < day1 Then month3 = month2 - 1 dateC1 = DateSerial(year2, month3, day1) DatDiffD = DateDiff("d", dateC1, Vdate2) Else DatDiffD = day2 - day1 End If End Function

جرب وضع معيار معرف العميل في الاستعلام .. تماما كما فعلت لمعرف الأقساط هكذا مثلا (تأكد من الرابط) : [Forms]![paymentcuss]![CustomersID] 🙂

وعليكم السلام ورحمة الله وبركاته أخي طاهر 🙂 رسمت لك هذه الصورة التوضيحية لمعرفة كيف يتم عمل روابط متسلسلة بين الجداول : لو اتبعت تصميم الجداول بهذه الطريقة فسيسهل عليك بإذن الله عمل القوائم المنسدلة 🙂

وعليكم السلام ورحمة الله وبركاته أخي gadelrab 🙂 هناك أكثر من طريقة لفتح الملفات (الروابط) خارج قاعدة البيانات .. منها على سبيل المثال : (1) followhyperlink ("C:\Document\File.Jpg") (2) تضع هذا الكود في موديول وتناديه في المكان المطلوب : Public Sub OpenPath(strPath As String) Shell "explorer.exe" & " " & strPath, vbNormalFocus End Sub وتناديه كالتالي : OpenPath "C:\Document\File.Jpg" (3) تضع هذا الكود في موديول وتناديه في المكان المطلوب : Public Sub OpenFilePath(sFilePath As String) CreateObject("Shell.Application").Namespace(0).ParseName(sFilePath).InvokeVerb "Open" End Sub وتناديه كالتالي: OpenFilePath "C:\Document\File.Jpg" (4) تضع هذا الكود في موديول وتناديه في المكان المطلوب : Public Declare PtrSafe Function FileProtocolHandler Lib "url.dll" _ Alias "FileProtocolHandlerA" (ByVal hwnd As Long, ByVal hinst As Long, _ ByVal lpszCmdLine As String, ByVal nShowCmd As Long) As Long Public Sub OpenHyperlink(ByVal Url) FileProtocolHandler 0, 0, Url, 1 End Sub وتناديه كالتالي: OpenHyperlink ("C:\Document\File.Jpg")

أخي يمكنك الاستفادة من الكود الموجود في الملف المرفق لحفظ مسميات الجداول وبقية عناصر قاعدة البيانات في جدول ثم استخراجها في تقرير وتصديره بأي صيغة كما تشاء 🙂 وكذلك هذا كود يحضر لك مسميات عناصر قاعدة البيانات اللي تشتغل عليها ويطبعها في نافذة الـ Immediate window .. لكن مع تعديل بسيط في الكود يمكن تصديرها للجدول . Sub AllContentsReport() ''my first, simplest code''''''''''''''''''''''''''' ''drawback: tables and queries in the same container ''therefore, then I skipped 3 containers ''1- containers for forms/reports/modules/macros ''2 -tabledefs for tables ''3 -querydefs for queries Dim dbs As DAO.Database Dim doc As DAO.Document Dim cont As DAO.Container Set dbs = CurrentDb For Each cont In dbs.Containers Debug.Print "Container:"; cont.Name, "---------------" For Each doc In cont.Documents If doc.Name Like "msys*" Or doc.Name Like "~*" Then Else Debug.Print doc.LastUpdated, doc.Name End If Next doc Next cont '''''''''''''''''' Dim tbl As DAO.TableDef Dim que As QueryDef '''''''''''''''''' Debug.Print "TableDefs:-------------------------" For Each tbl In dbs.TableDefs If tbl.Name Like "msys*" Or tbl.Name Like "~*" Then Else Debug.Print "~~"; tbl.Name, tbl.Connect & "" End If Next tbl '''''''''''''''''' Debug.Print "queryDefs:-------------------------" For Each que In dbs.QueryDefs If que.Name Like "~*" Then Else Debug.Print "~~"; que.Name, "-------------------------" Debug.Print que.SQL End If Next que End Sub

شكرا لك دكتور قاسم .. والشرف لي بمعرفتك ☺️🌹

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

السلام عليكم أخي قاسم 🙂 الحمدلله بعد العديد من المحاولات في جلب أسماء القواعد الخلفية المتعددة (وبدون تكرار) في حال أن القاعدة الواحدة لها أكثر من جدول، توصلت بفضل الله إلى الطريقة . الفكرة تتلخص في كود يحضر لك جميع مسارات القواعد الخلفية BE ويخزنها في متغير من نوع Collection وبدون تكرار .. ثم في حلقة Loop يقوم بإرسال مسارات أو روابط هذه القواعد إلى كود النسخ الإحتياطي Backup ليقوم بحفظ نسخة إحتياطية من القاعدة الخلفية بنفس المسمى + التاريخ والوقت .. يحفظها في مجلد Backup بجانب قاعدة البيانات . في الملف المرفق ستجدون 3 ملفات ( الواجهة : My_App_FE.accdb و القواعد الخلفية : BE_1.accdb و BE_2.accdb ) (ملاحظة : لن تحتاج لإعادة ربط الواجهة بالقواعد الخلفية ، فقد جعلتها ترتبط تلقائيا عند الفتح ) 🙂 سيفتح لك النموذج واضغط على حفظ وشاهد النتيجة 🙂 إنشاء مجلد الباكب تلقائيا : النسخ الإحتياطية : وهذا هو المرفق: 🙂 Backup Mor Than One BE.zip

فعلا أستاذنا العزيز ،، نسخة الأكسس 2003 تكوم بكتابة الكود تلقائيا في محرر الأكواد .. بينما النسخ الأحدث منه تضيف الأمر على شكل ماكرو . 🙂

تفضل أخي هذا التعديل 🙂 : مع ملاحظة أنني قمت بتحويل حقل الصورة إلى حقل نصي بدل (إرتباط) وذلك لتجنب بعض الإشكالات في الكود . لإضافة مرفقات إضافية تكرر سطر إضافة مرفق كل مرة كما هو موضح بالكود .. لأن في الصورة لديك مرفقان بينما في برنامجك مرفق واحد .. فإذا كنت ستكتفي بمرفق واحد ألغِ سطر المرفق الإضافي .. Dim MyOutlook As Object Set MyOutlook = CreateObject("Outlook.Application") Dim MyMail As Object Set MyMail = MyOutlook.CreateItem(olMailItem) MyMail.Attachments.Add Me.Imagepath.Value ' المرفقات MyMail.Attachments.Add "C:\file2.PDF" ' إضافة مرفق ثانٍ MyMail.Display ' لتشغيل برنامج الأوتلوك والتركيز عليه Set MyOutlook = Nothing Set MyMail = Nothing ارسال ايميل مع المرفق (1).rar

تفضل هذا كود تكرار السجل : 🙂 Private Sub DublicateRecBtn_Click() On Error GoTo Err_DublicateRecBtn_Click DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdCopy DoCmd.RunCommand acCmdRecordsGoToNew DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdPaste Exit_DublicateRecBtn_Click: Exit Sub Err_DublicateRecBtn_Click: MsgBox Err.Description Resume Exit_DublicateRecBtn_Click End Sub

خلاص هذا هو الكود اللي تحتاجه : Sub Send_Email_with_Attachment() ' You should add this library : Microsoft Outlook 16.0 Object Library Dim MyOutlook As Object Set MyOutlook = CreateObject("Outlook.Application") Dim MyMail As Object Set MyMail = MyOutlook.CreateItem(olMailItem) MyMail.Attachments.Add "C:\R_Emp.pdf" ' المرفقات MyMail.Display ' لتشغيل برنامج الأوتلوك والتركيز عليه Set MyOutlook = Nothing Set MyMail = Nothing End Sub بس لأنك ما خبرتني من وين تجيب المرفق .. تأكد أنك تحط رابط المرفق مكان هذي 🙂 : "C:\R_Emp.pdf"

طيب .. هناك بعض الأمور غير موضحة لا في السؤال ولا في المرفق .. 1- لمن سترسل الرسالة ؟ ( أين ستضع إيميل من سترسل له ؟) 2- أين يوجد المرفق ؟ هل سينشئه البرنامج ثم يرسله ؟ أم أنه مرفق ثابت فقط ستضع مسار الملف في الكود ؟ 3 - هل تريد البرنامج أن يرسل تقارير جميع الطلاب ؟ أم الطالب الحالي فقط ؟ ( لأنك وضعت حلقة تمر على جميع الطلاب في الكود ) 4 - تريد أن يفتح الآوتلوك ويقف وأنت ستضغط زر الإرسال ؟ أم يرسلها تلقائيا نيابة عنك ؟ هذه البيانات مهمة لكتابة الكود 🙂

أخي @MO87 تفضل هذا كود الإرسال بالآوتلوك مع إضافة المرفقات 🙂 عليك أن تستبدل البيانات الموجودة مقابل كل بيان ( المرسل إليه ، نسخة إلى ، مسودة ، العنوان ، الموضوع ، المرفقات ) تستبدلها بأسماء الحقول عندك في النموذج .. وكذلك عليك أن تضيف المكتبة : Microsoft Outlook 16.0 Object Library Sub Send_Email_with_Attachment() ' You should add this library : Microsoft Outlook 16.0 Object Library Dim MyOutlook As Object Set MyOutlook = CreateObject("Outlook.Application") Dim MyMail As Object Set MyMail = MyOutlook.CreateItem(olMailItem) MyMail.To = "ReceiverEmail@Gmail.com" ' المرسل إليه MyMail.CC = "ReceiverEmail@Gmail.com" ' نسخة إلى MyMail.BCC = "ReceiverEmail@Gmail.com" ' نسخة سرية إلى MyMail.Subject = "Email Title Here" ' عنوان الرسالة MyMail.Body = "This is a Sample Mail." ' محتوى الرسالة MyMail.Attachments.Add "C:\File1.PDF", "C:\File2.PDF" ' المرفقات MyMail.Send MsgBox "تم الإرسال بنجاح" Set MyOutlook = Nothing Set MyMail = Nothing End Sub

هذا اللقب يقود الناس المتعطشين للمعرفة إلى المنبع الصافي أمثالكم لقضاء حوائجهم 🙂 واحتسب الأجر عند الله ..

هذا الاسم يليق بك أكثر 😉 مقروناً باللقب المناسب لك (الخبير) 😊👌🏼

بما أن الأستاذ خالد قام بإحياء هذا الموضوع من جديد أحببت أن أدلو بدلوي 😁 هذه طريقتي لفصل الأرقام من النص .. والعكس نزع الحروف من بين الأرقام .. أولا : استخراج الأرقام من النص وحذف الحروف : Public Function ExtractNumbersFromText(strText As String) Dim x As Long Dim L As String Dim r As String For x = 1 To Len(strText) L = Mid(strText, x, 1) If IsNumeric(L) Then r = r & L End If Next x ExtractNumbersFromText = r End Function ثانيا : اسخراج الحروف وحذف الأرقام : Public Function RemoveNumbersFromText(strText As String) Dim x As Long Dim L As String Dim r As String For x = 1 To Len(strText) L = Mid(strText, x, 1) If Not IsNumeric(L) Then r = r & L End If Next x RemoveNumbersFromText = r End Function abc.rar

لاحظت شي 🙂 DoCmd.RunSQL "DELETE sanduk.yat , sanduk.DAT , sanduk.SAH FROM sanduk WHERE " & myCriteria & ";"

كذاك تبغاه الأخ سعيد ؟ 🙂 مدة عمل الموظف.rar

صارت لدي حاجة لمثل هذا .. 🙂 عندي برنامج يقوم بحفظ ملفات PDF بنفس أسماء الأشخاص حسب الموجود في الجدول .. كل شخص له ملف PDF باسمه .. لكن أحيانا يتم إدخال الاسم هكذا : " الفاضل / محمد أحمد سلامة " واللويندوز يرفض علامة الـ / في أسماء الملفات وعلامات أخرى مثل : #$%^<> حسب ما أذكر .. لذلك أنشأت دالة تقوم بتتبع هذه العلامات في الاسم قبل حفظ الملف واستبدالها بالرمز " - " أو مسافة فارغة " " (ويمكنك تحديد البديل كما تشاء ) .. بدون تغيير البيانات في الجدول طبعا .. وهذه هي الدالة التي أنشأتها .. ويمكن تعديلها حسب الحاجة وتغيير الرموز المطلوبة فيها وتعيين البديل .. Public Function RemoveSymbolsFromText(strGivenTxt As String, Optional ReplacmentTxt As String = "") As String Dim Txt As String Dim R As String R = ReplacmentTxt Txt = strGivenTxt Txt = Replace(Txt, "!", R) Txt = Replace(Txt, "@", R) Txt = Replace(Txt, "#", R) Txt = Replace(Txt, "$", R) Txt = Replace(Txt, "%", R) Txt = Replace(Txt, "^", R) Txt = Replace(Txt, "*", R) Txt = Replace(Txt, "\", R) Txt = Replace(Txt, "|", R) Txt = Replace(Txt, "/", R) Txt = Replace(Txt, ".", R) Txt = Replace(Txt, "?", R) Txt = Replace(Txt, """", R) Txt = Replace(Txt, "'", R) Txt = Replace(Txt, "<", R) Txt = Replace(Txt, ">", R) Txt = Replace(Txt, "؟", R) Txt = Replace(Txt, "~", R) Txt = Replace(Txt, "&", R) RemoveSymbolsFromText = Txt End Function وتستدعيها هكذا : RemoveSymbolsFromText(strGivenTxt, "_")

الاستعلامات تفعل ذلك .. أليس كذلك ؟ 🙂

أعتقد أن المثال الذي يريده الأخ قاسم يتعلق ببرنامج يتم توزيعه على أفرع المؤسسة في عدة مدن مختلفة .. وبعد مدة معينة يتم تجميع البيانات الموزعة على الأفرع في البرنامج الرئيسي لإدارة المؤسسة .. والمثال الذي ذكره الأستاذ @ابوخليل يعالج هذه القضية وهي فكرة إبداعية .. فقط يحتاجله بعض البهارات من الـVBA لجعل العملية تصير بشكل أوتوماتيكي 🙂 ..