Moosak

ألغ هذا الجزء من الكود أخي محمد : 🙂

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

للنسخة العادية من الواتسأب غير متاح .. ولكن للنسخة التجارية المدفوعة يمكن عن طريق دوال ال Api الخاصة بشركة الواتسأب .. هذه يمكنك فعلها بسهولة .. قبل مناداة الدالة التي ذكرتها .. قم بتجميع البيانات التي تريد إرسالها للأشخاص في متغير واحد (بحيث تتغير الرسالة لكل شخص) ثم أرسله لدالة الواتسأب لإرسالها بالشكل النهائي .. ( يحتاجلك تتعلم هذه المهارات سهلة 😉👌🏼 ) هذه لا علم لي بها بعد .. 🙂

:: إضـــــافـــة :: هذا هو الموديول الذي يمكنك نقله إلى برنامجك الخاص ومناداته باسم الدالة .. Option Compare Database Option Explicit Enum AttacmentsType Image = 1 Sticker = 2 Document = 3 End Enum #If VBA7 Or Win64 Then Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Declare PtrSafe Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As LongPtr) As LongPtr Public Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer #Else Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer #End If Private Const VK_NUMLOCK = &H90 Public Sub SendToWhatsApp(txtPhone As String, txtMSG As String, Optional txtAttchmentPath As String = "", Optional AttachmentType As AttacmentsType = Image) '---------------------------------------(التحقق من اكتمال البيانات) If Len(txtMSG & "") = 0 Then MsgBox "يرجى كتابة الرسالة": Exit Sub If txtAttchmentPath <> "" Then If Len(Dir(txtAttchmentPath, vbDirectory)) = 0 Then MsgBox "المرفق غير موجود .. تأكد من الرابط": Exit Sub End If txtMSG = Replace(txtMSG, vbCrLf, " %0a ") txtMSG = Replace(txtMSG, Chr(10), " %0a ") txtMSG = Replace(txtMSG, Chr(13), " %0a ") '---------------------------------------(بداية الإرسال) Dim Path As String Path = "whatsapp://send?phone=" & txtPhone & "&text=" & txtMSG CreateObject("Shell.Application").Namespace(0).ParseName(Path).InvokeVerb "Open" ' إرسال الرسالة Sleep 2000 SendKeys "~" Sleep 500 SendKeys "~" ' إرسال المرفق إن وجد If txtAttchmentPath <> "" Then SendKeys "+{TAB}" SendKeys "~" Sleep 1000 Select Case AttachmentType Case Is = 1 ' صورة SendKeys "{UP}" ' لإرسال الصور ' SendKeys "{UP}" ' لإرسال الملصقات ' SendKeys "{UP}" ' لفتح الكاميرة ' SendKeys "{UP}" ' لإرسال مستند ' SendKeys "{UP}" ' لإرسال جهة إتصال Case Is = 2 ' ملصق SendKeys "{UP}" ' لإرسال الصور SendKeys "{UP}" ' لإرسال الملصقات ' SendKeys "{UP}" ' لفتح الكاميرة ' SendKeys "{UP}" ' لإرسال مستند ' SendKeys "{UP}" ' لإرسال جهة إتصال Case Is = 3 ' مستند SendKeys "{UP}" ' لإرسال الصور SendKeys "{UP}" ' لإرسال الملصقات SendKeys "{UP}" ' لفتح الكاميرة SendKeys "{UP}" ' لإرسال مستند ' SendKeys "{UP}" ' لإرسال جهة إتصال End Select SendKeys "~" Sleep 1000 SendKeys txtAttchmentPath, True SendKeys "~" Sleep 2000 SendKeys "~" Sleep 1000 SendKeys "~" End If 'If NumLock is off, turn it on If GetKeyState(VK_NUMLOCK) = 0 Then 'Send NumLock key press to turn it on SendKeys "{NUMLOCK}" End If '---------------------------------------( إعادة التركيز لبرنامج الأكسس) SetForegroundWindow Application.hWndAccessApp ' MsgBox " تم الإرســــــال ", vbMsgBoxRight, "" End Sub وهكذا تنادي الدالة : SendToWhatsApp "96899445566", "السلام عليكم", "C:\Users\User\Desktop\123.jpg", Image

اعرض الملف 🎁 :: مرسال الواتسأب :: 📨 :: الإصدار الثاني 2.0 :: مطور :: 🧬🏹 السلام عليكم ورحمة الله وبركاته يسرني اليوم أن أقدم لكم هذه الهدية المتميزة والرائعة (مرسال الواتسأب) مع المرفقات مرسال الواتسأب مع المرفقات | سلسلة هدايا الأكسس | 03| 🎁 وهو عبارة عن برنامج صغير لإرسال الرسائل للواتسأب مع المرفقات .. :: من مميزات هذا الإصدار :: - إرسال رسائل فردية أو جماعية عن طريق برنامج الواتسأب . - لا يحتاج لبرنامج الإنترنت إكسبلورر لفتح الواتسأب. - لا يغلق مفتاح الـ NumLock بعد الإرسال. -تم اختصار الكود في موديول واحد ودالة واحدة تقوم بعملية الإرسال بعدة خيارات . - لو أردت تطبيق الكود في برنامجك الخاص ستحتاج لنقل الموديول إلى برنامجك + سطر برمجي واحد فقط لعملية الإرسال. :: شرح البرنامج :: :: لتحميل البرنامج :: صاحب الملف Moosak تمت الاضافه 30 مار, 2023 الاقسام قسم الأكسيس

أتفق معك تماما عمي المهندس خالد @متقاعد 🙂 وكان جوابي السابق لأخي @ابو هاله النبلسي عن طريقة استخدام الأداة وعن الصياغة .. ولم يكن عن المنطق .. أما لو تطرقنا للمنطق وطبقنا فكرتك عمي خالد فهنا الأمر يتطلب إضافة معيار جديد للقيمة الفريدة كالـ ID مثلا .. وتطبيقه بالأداة سيكون هكذا : والدالة الناتجة هكذا : DLookUp("[First Name]","[SampleTable]","[BirthDate] >=#"& [Forms]![SampleForm]![TxtBox1] &"# And [BirthDate] <=#"& [Forms]![SampleForm]![TxtBox2] &"# And [ID] =90 ") وهذا ينطبق على المعامل Like .. الحل يكمن في إضافة المعيار الفريد .. 🙂

تذكرت الآن شيء يغنيك عن الإضافة اليدوية أخي @ابو هاله النبلسي 🙂 يمكنك استخدام هذه الطريقة .. بدل استخدام Between استخدم المعيارين <= و >= بهذه الطريقة وستعطيك نفس نتيجة المعامل Between .. هكذا : ووهذه هي الدالة الناتجة : DSum("[Salary]","[SampleTable]","[BirthDate] >=#"& [Forms]![SampleForm]![TxtBox1] &"# And [BirthDate] <=#"& [Forms]![SampleForm]![TxtBox2] &"# ") 🙂

مشاركة خفيفة مع العم @ابوخليل 🙂 طريقة الحصول على تاريخ أول يوم وآخر يوم في الأسبوع بأسهل طريقة بناءا على تاريخ اليوم ()Date : startWeek = DateAdd("d", -(Weekday(Date) - 1), Date) endWeek = DateAdd("d", 6, DateAdd("d", -(Weekday(Date) - 1), Date)) ولمعرفة أول يوم وآخر يوم في الأسبوع لتاريخ معين (غير تاريخ اليوم) .. قم باستبدال Date بالتاريخ الذي تريده .

آمين يارب العالمين .. وإياكم أخي @ابو هاله النبلسي 🙂

لاختيار التاريخين من نموذج ستقوم بعمل تعديلات على الدالة يدويا هكذا : الدالة التي ستعطيك إياها الأداة : DLookUp("[CreationDate]","[SubjectsF]","[CreationDate] Between #"& [Forms]![Formena]![txt1] &"#") والدالة بعد التعديل اليدوي : DLookUp("[CreationDate]","[SubjectsF]","[CreationDate] Between #"& [Forms]![Formena]![txt1] &"# and #"& [Forms]![Formena]![txt2] &"#") وهذا شكلها :

هذا مثال أخي أبو هالة 🙂 وبالتقريب هكذا تكتب التاريخ في المعيار (لأن الأداة تضيف الرمز # في البداية والنهاية لوحدها) : 16/2/2021# and #28/2/2021

وجرب الدالة بهذا الشكل لوضع المعامل Like إن شئت وإظهار جميع السجلات لو كان النموذجان مغلقان : Public Function Frm1_or_Frm2() As String If CurrentProject.AllForms("frm1").IsLoaded = True Then Frm1_or_Frm2 = "Like '*' & [forms]![frm1]![type] & '*'" ElseIf CurrentProject.AllForms("frm2").IsLoaded = True Then Frm1_or_Frm2 = "Like '*' & [forms]![frm2]![type] & '*'" Else Frm1_or_Frm2 = "Like '*'" End If End Function وتكتب تحت المعيار : Frm1_or_Frm2()

بالنسبة لي أحب حل مثل هذه الأمور بعمل دالة عامة يتم استدعائها في المعيار .. وهذه هي الدالة على حسب مثالك 🙂 : Public Function Frm1_or_Frm2() As String If CurrentProject.AllForms("frm1").IsLoaded = True Then Frm1_or_Frm2 = "[forms]![frm1]![type]" ElseIf CurrentProject.AllForms("frm2").IsLoaded = True Then Frm1_or_Frm2 = "[forms]![frm2]![type]" Else Frm1_or_Frm2 = "" End If End Function بعد أن تضع الدالة في موديول .. تضع اسم الدالة في المعيار هكذا : = Frm1_or_Frm2() والدالة هي ستتولى عملية الفحص .. 🙂 ملاحظة : لو كان النموذجين كلاما مغلق في نفس اللحظة يضع فراغ في المعيار ..

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

السلام عليكم 🙂 أخي العزيز @أبو امين .. لا تعجل على إخوانك .. فلا يعلم بظروفهم إلا الله .. وخصوصا منهم من قلص حصة المنتدى من الوقت في رمضان ليتفرغ للعبادة 🙂 .. والحقيقة كانت لي محاولات في تعديل ملفك ولكن .. كلها لم تنجح وتحتاج لمزيد من الوقت .. وربما لتغييرات جذرية في الكود ولكن لم أتفرغ لها .. نعم أخي @عمر ضاحى .. استخدم هذه الدالة لمبدعنا @ابو جودي 🙂 : '==============================================( MnthName) اسماء الشهور الهجرى - العربى( الميلادى) - الانجليزيى( الميلادى) - اختصارالانجليزيى( الميلادى) - القبطى - السريانى' ' .__ __. ___ .___ ___. _______ _______. ______ _______ .___________. __ __ _______ .___ ___. ______ .__ __. .___________. __ __ _______. ' | \ | | / \ | \/ | | ____| / | / __ \ | ____| | || | | | | ____| | \/ | / __ \ | \ | | | || | | | / | ' | \| | / ^ \ | \ / | | |__ | (----` | | | | | |__ `---| |----`| |__| | | |__ | \ / | | | | | | \| | `---| |----`| |__| | | (----` ' | . ` | / /_\ \ | |\/| | | __| \ \ | | | | | __| | | | __ | | __| | |\/| | | | | | | . ` | | | | __ | \ \ ' | |\ | / _____ \ | | | | | |____ .----) | | `--' | | | | | | | | | | |____ | | | | | `--' | | |\ | | | | | | | .----) | ' |__| \__| /__/ \__\ |__| |__| |_______||_______/ \______/ |__| |__| |__| |__| |_______| |__| |__| \______/ |__| \__| |__| |__| |__| |_______/ ' Public Function MnthName(ByVal dtAnyDate As Date, ByVal strLng As String) 'to call the Function 'To Hijri 'txtMonthNameHijri =MnthName(txtDate,"HJ") 'To Arabic 'txtMonthNameArabic =MnthName(txtDate,"Ar") 'To English 'txtMonthNameEnglish =MnthName(txtDate,"En") 'To English Short 'txtMonthNameEnglish =MnthName(txtDate,"EnShrt") 'To Coptic 'txtMonthNameCoptic =MnthName(txtDate,"Cpti") 'To Syriac 'txtMonthNameSyriac =MnthName(txtDate,"Syr") Dim str01 As String Dim str02 As String Dim str03 As String Dim str04 As String Dim str05 As String Dim str06 As String Dim str07 As String Dim Str08 As String Dim Str09 As String Dim Str10 As String Dim Str11 As String Dim Str12 As String If strLng = "HJ" Then str01 = ChrW("1605") & ChrW("1581") & ChrW("1585") & ChrW("1605") str02 = ChrW("1589") & ChrW("1601") & ChrW("1585") str03 = ChrW("1585") & ChrW("1576") & ChrW("1610") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") str04 = ChrW("1585") & ChrW("1576") & ChrW("1610") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1570") & ChrW("1582") & ChrW("1585") str05 = ChrW("1580") & ChrW("1605") & ChrW("1575") & ChrW("1583") & ChrW("1610") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") & ChrW("1610") str06 = ChrW("1580") & ChrW("1605") & ChrW("1575") & ChrW("1583") & ChrW("1610") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1570") & ChrW("1582") & ChrW("1585") & ChrW("1577") str07 = ChrW("1585") & ChrW("1580") & ChrW("1576") Str08 = ChrW("1588") & ChrW("1593") & ChrW("1576") & ChrW("1575") & ChrW("1606") Str09 = ChrW("1585") & ChrW("1605") & ChrW("1590") & ChrW("1575") & ChrW("1606") Str10 = ChrW("1588") & ChrW("1608") & ChrW("1575") & ChrW("1604") Str11 = ChrW("1584") & ChrW("1608") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1602") & ChrW("1593") & ChrW("1583") & ChrW("1577") Str12 = ChrW("1584") & ChrW("1608") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1581") & ChrW("1580") & ChrW("1577") ElseIf strLng = "Ar" Then str01 = ChrW("1610") & ChrW("1606") & ChrW("1575") & ChrW("1610") & ChrW("1585") str02 = ChrW("1601") & ChrW("1576") & ChrW("1585") & ChrW("1575") & ChrW("1610") & ChrW("1585") str03 = ChrW("1605") & ChrW("1575") & ChrW("1585") & ChrW("1587") str04 = ChrW("1571") & ChrW("1576") & ChrW("1585") & ChrW("1610") & ChrW("1604") str05 = ChrW("1605") & ChrW("1575") & ChrW("1610") & ChrW("1608") str06 = ChrW("1610") & ChrW("1608") & ChrW("1606") & ChrW("1610") & ChrW("1577") str07 = ChrW("1610") & ChrW("1608") & ChrW("1604") & ChrW("1610") & ChrW("1577") Str08 = ChrW("1571") & ChrW("1594") & ChrW("1587") & ChrW("1591") & ChrW("1587") Str09 = ChrW("1587") & ChrW("1576") & ChrW("1578") & ChrW("1605") & ChrW("1576") & ChrW("1585") Str10 = ChrW("1575") & ChrW("1603") & ChrW("1578") & ChrW("1608") & ChrW("1576") & ChrW("1585") Str11 = ChrW("1606") & ChrW("1608") & ChrW("1601") & ChrW("1605") & ChrW("1576") & ChrW("1585") Str12 = ChrW("1583") & ChrW("1610") & ChrW("1587") & ChrW("1605") & ChrW("1576") & ChrW("1585") ElseIf strLng = "En" Then str01 = "January" str02 = "February" str03 = "March" str04 = "April" str05 = "May" str06 = "June" str07 = "July" Str08 = "August" Str09 = "September" Str10 = "October" Str11 = "November" Str12 = "December" ElseIf strLng = "EnShrt" Then str01 = "Jan" str02 = "Feb" str03 = "Mar" str04 = "Apr" str05 = "May" str06 = "Jun" str07 = "Jul" Str08 = "Aug" Str09 = "Sep" Str10 = "Oct" Str11 = "Nov" Str12 = "Dec" ElseIf strLng = "Cpti" Then str01 = ChrW("1591") & ChrW("1608") & ChrW("1576") & ChrW("1577") str02 = ChrW("1571") & ChrW("1605") & ChrW("1588") & ChrW("1610") & ChrW("1585") str03 = ChrW("1576") & ChrW("1585") & ChrW("1605") & ChrW("1607") & ChrW("1575") & ChrW("1578") str04 = ChrW("1576") & ChrW("1585") & ChrW("1605") & ChrW("1608") & ChrW("1583") & ChrW("1577") str05 = ChrW("1576") & ChrW("1588") & ChrW("1606") & ChrW("1587") str06 = ChrW("1576") & ChrW("1572") & ChrW("1608") & ChrW("1606") & ChrW("1577") str07 = ChrW("1571") & ChrW("1576") & ChrW("1610") & ChrW("1576") Str08 = ChrW("1605") & ChrW("1587") & ChrW("1585") & ChrW("1609") Str09 = ChrW("1578") & ChrW("1608") & ChrW("1578") Str10 = ChrW("1576") & ChrW("1575") & ChrW("1576") & ChrW("1577") Str11 = ChrW("1607") & ChrW("1575") & ChrW("1578") & ChrW("1608") & ChrW("1585") Str12 = ChrW("1603") & ChrW("1610") & ChrW("1575") & ChrW("1607") & ChrW("1603") ElseIf strLng = "Syr" Then str01 = ChrW("1603") & ChrW("1575") & ChrW("1606") & ChrW("1608") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1579") & ChrW("1575") & ChrW("1606") & ChrW("1610") str02 = ChrW("1588") & ChrW("1576") & ChrW("1575") & ChrW("1591") str03 = ChrW("1570") & ChrW("1584") & ChrW("1575") & ChrW("1585") str04 = ChrW("1606") & ChrW("1610") & ChrW("1587") & ChrW("1575") & ChrW("1606") str05 = ChrW("1571") & ChrW("1610") & ChrW("1575") & ChrW("1585") str06 = ChrW("1581") & ChrW("1586") & ChrW("1610") & ChrW("1585") & ChrW("1575") & ChrW("1606") str07 = ChrW("1578") & ChrW("1605") & ChrW("1608") & ChrW("1586") Str08 = ChrW("1570") & ChrW("1576") Str09 = ChrW("1571") & ChrW("1610") & ChrW("1604") & ChrW("1608") & ChrW("1604") Str10 = ChrW("1578") & ChrW("1588") & ChrW("1585") & ChrW("1610") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") Str11 = ChrW("1578") & ChrW("1588") & ChrW("1585") & ChrW("1610") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1579") & ChrW("1575") & ChrW("1606") & ChrW("1610") Str12 = ChrW("1603") & ChrW("1575") & ChrW("1606") & ChrW("1608") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") End If MnthName = Choose(Format(dtAnyDate, "MM"), str01, str02, str03, str04, str05, str06, str07, Str08, Str09, Str10, Str11, Str12) End Function '----------------------------End------------------------------------------------------------------------------------------- شخابيط وافكار : Date Functions - دوال التاريخ بطعم جديد وتحكم شامل

ماشاء الله تبارك الله 🙂 عمل جميل جدا .. ويفتح آفاق وأفكار كثيرة .. 😉 الشكر لك عمي @ابوخليل والشكر موصول للأستاذ @حسونة حسين ربما يمكننا بطريقة ما تحويله إلى ملف أكسس ( وهو تخصص منتدانا ) بصفحة بحث ميسرة 🙂 .. وهل المواضيع متجددة ( تحدث نفسها ) ؟؟ 👍🏼 ✨ موضوع مميز ✨ 👍🏼 .. يثبت 📌

وعليكم السلام ورحمة الله وبركاته عمي قاسم 🙂 وكل عام وانت بخير وصحة وسلامة بمناسبة الشهر الفضيل .. أستأذنك في نقل الموضوع الى المنتدى المفتوح للاختصاص .. وبارك الله لنا في عمرك وصحتك وعلمك 🙂🌹

هذا كود يقوم بنسخ السجل الحالي وتكراره 🙂 '===================================== تكرار السجل 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

أخي @أبو امين أرفق الملف ...

😅👇 تستخدم بالحد المعقول .. وتقلل مدة الانتظار في الكود .. وهذي لحالها فكرة 🙂

وعليكم السلام ورحمة الله وبركاته 🙂 سلمنا الله لرمضان، وسلم رمضان لنا، وتسلمه منا ومنكم متقبلا إن شاء الله 🤲🏼 وكل عام وأنتم بخير ☺️🌹

شكرا لكم جميعاً 🙂 🌹

موضوع مميز .. ✨ يثبت ✨ 👍🙂 تم إضافة المرفق إلى المشاركة الأولى لتسهيل الوصول إليه 🙂

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته 🙂 درسنا اليوم عبارة عن فكرة تجميلية لقاعدة البيانات وإظهار شاشة إنتظار عند الإنتقال بين النماذج.. فكرة لمعت وحبيت أوثقها قبل أن تطير بلا عودة 😅 متابعة ممتعة 🙂 حمل المثال من المرفقات .. Waiting Screen.accdb