Moosak

تستطيع التحكم بجميع ذلك من الاستعلام .. بحيث تضع فيه المعايير التي تريد الطباعة عليها .. 🙂 فلو كان عندك في الجدول حقل تاريخ الإجازة [من - إلى ] مثلا فتكتب في معايير التاريخ في الاستعلام : < [FromDate] or > [ToDate]

وعليكم السلام ورحمة الله وبركاته 🙂 أخي @أبو ماجد الغامدي أنا لي رأي بخصوص عملية نقل السجلات من جدول إلى جدول آخر .. لاحظت من خلال مواضيعك في المنتدى تفعل ذلك كثيرا .. 🙂 أقترح عليك أن تغير هذه الطريقة إلى طريقة أكثر أمانا وأقل عبئا على قاعدة البيانات .. وهي : بما أن البيانات هي نفسها فقط تريد أن تستدعيها كل مرة بطريقة مختلفة ،، فأقترح عليك أن تكتفي بجدول واحد فقط .. بحيث أنك تضع جميع الحقول التي تريدها في نفس الجدول وتضع من ضمن الحقول التصنيفات المختلفة لكل سجل وذلك لكي تستدعي السجلات المطلوبة فقط عن طريق الاستعلامات .. فمثلا تضيف خانة عبارة عن حقل ( نعم / لا ) وتستخدمه لفرز موظفين معينين ، وحقل ( نعم / لا ) آخر لفرز فئات أخرى .. وهكذا .. وتطبيقا على مثالك الحالي (لم أشاهد المرفق بعد 🙂 ) .. أضف في نفس الجدول حقل ( نعم / لا ) وباستعلام تحديث يعمل صح إذا كان التاريخ متحقق .. واستعلام تحديث ثاني يشيل الصح إذا بترجعهم من جديد .. هذا وسلامتك 🙂🖐

لأن العلم معينه لا ينضب هذي إضافة جديدة أخرى 😊 ماذا لو أردنا منه تلوين الخلايا الفارغة باللون الأصفر مثلا 😏 : Private Sub Form_BeforeUpdate(Cancel As Integer) Dim I_am_Empty As String, Set_Focus_On_Me As Control Dim ctl As Control For Each ctl In Me.Controls If ctl.ControlType = acTextBox Then ctl.BackColor = vbWhite If Len(ctl.Value & "") = 0 Then I_am_Empty = I_am_Empty & vbCrLf & ctl.Name Set Set_Focus_On_Me = ctl ctl.BackColor = vbYellow End If End If Next ctl If Len(I_am_Empty & "") <> 0 Then Cancel = True MsgBox "رجاء تعبئة الحقول الفارغة التالية" & I_am_Empty Set_Focus_On_Me.SetFocus Exit Sub End If Set ctl = Nothing: Set Set_Focus_On_Me = Nothing End Sub بس المشكلة أنه يلون العمود كاملا وليس السطر الحالي فقط 😅

بارك الله فيك أستاذنا العزيز @ابوبسمله 🙂 فعلا كود رائع ويحل معضلة عويصة 😅 وأستأذنك في وضع الكود هنا ليسهل البحث عنه واستخدامه .. Public Function RowNum(frm As Form) As Variant On Error GoTo Err_RowNum 'Purpose: Numbering the rows on a form. 'Usage: Text box with ControlSource of: =RowNum([Form]) With frm.RecordsetClone .Bookmark = frm.Bookmark RowNum = .AbsolutePosition + 1 End With Exit_RowNum: Exit Function Err_RowNum: If Err.Number <> 3021& Then 'Ignore "No bookmark" at new row. Debug.Print "RowNum() error " & Err.Number & " - " & Err.Description End If RowNum = Null Resume Exit_RowNum End Function

ملاحظة عمي خالد : الكود للحبيب @ابوبسمله 🙂

الله .. الله .. ما أجمل هذي المدارسة بين الفطاحل 😄 وهذه إضافة من عندي 😁 يمكن الخروج من الكود أيضا بكتابة كلمة End فقط والتركيز على الحقل الفارغ ( لندمج الأفكار 😉 ) فيصبح الكود هكذا : Dim ctl As Control For Each ctl In Me.Controls If ctl.ControlType = acTextBox Then If Len(ctl.Value & "") = 0 Then Cancel = True ctl.SetFocus MsgBox "رجاء تعبئة الحقل الفارغ " & ctl.name End End If End If Next ctl

شكرا لك أخي أبو بسملة 🙂 وهذي إضافة بسيطة لنفس الكود في حال أردت ألا تلتغي البيانات .. وإنما يعطيك رسالة تنبيه لإكمال الحقول الناقصة 🙂 Private Sub Form_BeforeUpdate(Cancel As Integer) Dim ctl As Control For Each ctl In Me.Controls If ctl.ControlType = acTextBox Then If Len(ctl.Value & "") = 0 Then MsgBox "كمل شغلك :)" Cancel = True End If End If Next ctl End Sub

أخي @TQTHAMI مبارك عليك حصولك على الحل الصحيح .. 🙂 وتنبيه بسيط جدا : خيار أفضل إجابة يوضع على مشاركة الشخص التي حققت المطلوب ، تعبيرا عن شكرك له .. وتسهيلا للوصول إليها لاحقا 🙂🌹

وهذي لها حل بدون ما تعمل تقرير ثاني أخي علي 😉 كتبت معيار البحث في الاستعلام بهذي الطريقة : Like "*" & Nz([Forms]![نموذج1]![txt];"*") & "*" بمعنى : أنه يحضر السجلات التي بها كلمة البحث .. وإذا مربع البحث فاضي ( يحط مكانه * ) ويجيب كل السجلات .. Search in MultiValue Feild.rar

وعليكم السلام ورحمة الله وبركاته 🙂 تفضل أخي علي .. التعديل في مصدر بيانات التقرير . Search in MultiValue Feild.rar

اللهم آمين .. يارب العالمين .. 🙂🤲 وإياكم جميعا أخي أبو ماجد 😊🌹

الموضوع الذي أشار له أخي محمد احمد لطفى يقوم بحذف الجداول المرتبطة بشكل كامل .. ولمزيد فائدة .. هذا الكود يقوم بإلغاء ارتباط الجداول ( بدون حذفها من البرنامج ) : Public Function DeleteLinks() As Boolean On Error GoTo Err_Handler Dim dbs As DAO.Database Dim lng As Long Set dbs = CurrentDb With dbs.TableDefs For lng = .Count - 1 To 0 Step -1 If (.Item(lng).Attributes And dbAttachedTable) <> 0 Then .Delete .Item(lng).Name End If Next lng End With DeleteLinks = True Exit_Handler: On Error Resume Next Set dbs = Nothing Exit Function Err_Handler: MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number Resume Exit_Handler End Function 🙂

وعليكم السلام ورحمة الله وبركاته أخي ahmedsaadzeed 🙂 ننتظر إبداعاتك أخي العزيز .. أعرض الموضوع كما تحب .. وكما تراه مناسبا .. ولا نستغني عن أفكاركم الرائعة 👍🏼 😉🌹

وعليكم السلام أخي حمدي 🙂 مثل ما ذكر أخي Kanory شركة الواتسأب قامت بعمل تحديث على برنامجها .. وبما أن الأكواد الموجودة معتمدة على تقنية إرسال المفاتيح .. فمع التحديث الجديد لم تعد الطريقة السابقة مجدية .. ( إلا إذا كنت لا تزال تعمل على النسخة القديمة ) .. شيء آخر .. ( وقد ذكرت ذلك في موضوع مرسال الواتسأب ) أن الاحتياجات تختلف من شخص لآخر .. وبذلك ستختلف طريقة كتابة الكود بناءا على احتياجاتك .. لذا يستدعي الأمر ( فهم ) آلية عمل الكود ليسهل عليك التغيير فيه حسب حاجتك 🙂 لذلك حسب فهمي لما تريده .. هو أنك ستحتاج لحفظ شهادة كل طالب كملف PDF بشكل مؤقت ثم تشغل كود الإرسال للواتسأب بحيث توجهه إلى موقع الملف ( الشهادة ) .. ثم يحذف ملف الشهادة المؤقت وينتقل إلى الطالب التالي .. وهكذا ..

جرب الآن أبو ماجد 🙂 compoboxMoosak.zip

وهذه طرق أخرى مشاركة مع أخي محمد 🙂 '(1) strPath = "C:\Program Files (x86)\adobe\photoshop.exe" Shell "explorer.exe" & " " & strPath, vbNormalFocus --------------------------------------------------------------------- '(2) sFilePath = "C:\Program Files (x86)\adobe\photoshop.exe" CreateObject("Shell.Application").Namespace(0).ParseName(sFilePath).InvokeVerb "Open"

شوف هذا النموذج أخي وليد 🙂

الله يسلمك يابو ماجد .. 🙂 تشابهت الأسماء .. جرب الحين .. ويحتاجلك تحط بيانات زيادة في الجدول لتتضح النتيجة compoboxMoosak.zip

تفضل جرب أبو ماجد 🙂

وعليكم السلام ورحمة الله وبركاته أخي الحلبي .. 🙂 أنصحك بهذا الموقع .. مليئ بالأيقونات بمختلف الأشكال والألوان والأحجام .. وفيه خاصية البحث .. ستجد فيه كل ما تحتاجه من الأيقونات .. وهو مرتب ومنظم في مجموعات .. وووو .. 😁 https://icons8.com/icons/set/Sales

أنا جربت الكود السابق وكانت النتيجة ممتازة .. 👍 وحتى أنه يغنيك عن أكواد النسخ واللصق .. فقط تكتب له ( من ـ إلى .... والقياس المطلوب ) .. والسلام 🙂 شيل كلمة True, اللي بالأحمر هكذا تكتب الدالة بشكل صحيح : WIA_ResizeImage("C:\Users\mostafa\Documents\tt\Pic\1.jpg","C:\Users\mostafa\Documents\tt\Pics\1.jpg",150, 150)

وعليكم السلام ورحمة الله 🙂 من خلال البحث في الانترنت وجدت هذا الكود ، وظيفته أن يغير ( حجم ، قياسات ، أبعاد ، ... ) الصور 🙂 وطريقة الاستخدام مشروحة في الكود نفسه : '--------------------------------------------------------------------------------------- ' Procedure : WIA_ResizeImage ' Author : Daniel Pineault, CARDA Consultants Inc. ' Website : http://www.cardaconsultants.com ' Purpose : Resize an image based on Max width and Max height using WIA ' Copyright : The following may be altered and reused as you wish so long as the ' copyright notice is left unchanged (including Author, Website and ' Copyright). It may not be sold/resold or reposted on other sites (links ' back to this site are allowed). ' Req'd Refs: Uses Late Binding, so none required ' ' Windows Image Acquisition (WIA) ' https://msdn.microsoft.com/en-us/library/windows/desktop/ms630368(v=vs.85).aspx ' ' Input Variables: ' ~~~~~~~~~~~~~~~~ ' sInitialImage : Fully qualified path and filename of the original image to resize ' sResizedImage : Fully qualified path and filename of where to save the resized image ' lMaximumWidth : Maximum allowable image width ' lMaximumHeight: Maximum allowable image height ' ' Usage: ' ~~~~~~ ' Call WIA_ResizeImage("C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum.jpg", _ ' "C:\Users\MyUser\Desktop\Chrysanthemum_small.jpg", _ ' 800, 600) ' ' Revision History: ' Rev Date(yyyy/mm/dd) Description ' ************************************************************************************** ' 1 2017-01-18 Initial Release '--------------------------------------------------------------------------------------- Public Function WIA_ResizeImage(sInitialImage As String, sResizedImage As String, _ lMaximumWidth As Long, lMaximumHeight As Long) As Boolean On Error GoTo Error_Handler Dim oWIA As Object 'WIA.ImageFile Dim oIP As Object 'ImageProcess Set oWIA = CreateObject("WIA.ImageFile") Set oIP = CreateObject("WIA.ImageProcess") oIP.Filters.Add oIP.FilterInfos("Scale").FilterID oIP.Filters(1).Properties("MaximumWidth") = lMaximumWidth oIP.Filters(1).Properties("MaximumHeight") = lMaximumHeight oWIA.LoadFile sInitialImage Set oWIA = oIP.Apply(oWIA) oWIA.SaveFile sResizedImage WIA_ResizeImage = True Error_Handler_Exit: On Error Resume Next If Not oIP Is Nothing Then Set oIP = Nothing If Not oWIA Is Nothing Then Set oWIA = Nothing Exit Function Error_Handler: MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: WIA_ResizeImage" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occurred!" Resume Error_Handler_Exit End Function المصدر : https://www.devhut.net/vba-resize-image/

أخي @alsihran لدي فضول حول هذه النقطة .. 🙂 لماذا لا يقبل السيرفر تشغيل الأوامر البرمجية VBA ؟ هل بسبب تعطيل الصلاحيات من قبل فنيي الحاسب الآلي ؟

وعليكم السلام ورحمة الله وبركاته 🙂 تفضل .. ضع هذه الصيغة في حقل حساب فارق الوقت : IIf(DateDiff("n";[ofical inted];[time in])>=0;DateDiff("n";[ofical inted];[time in]);0) والباقي على الشباب 😊

شكرا جزيلا على البرنامج .. 🙂 بس شكله مصمم ليعمل على نسخة 32 بت ، لم يعمل على نسخة 64 بت .