نجوم المشاركات

السلام عليكم كل عام وانتم طيبين اولا مشاركه مع اخى محمد البرناوى جزاه الله خيرا وع حسب المرفق الذى ارفقته يوجد لديك سجلات فى الجدول tbl_Loans وفى الحقل Loan_ID فارغ وتخص شهر 3 وهذا الحقل مطلوب فى بعض الدوال لاستخراج القيم قم بحذف هذه السجلات وتقريبا حوالى 163 سجل وستجد بان النتائج قد ظهرت بصوره طبيعيه بالتوفيق

السلام عليكم كل عام وانتم بخير رمضان كريم اتفضل ان شاء الله يكون ما تريد والتغيير تم فى هذا السطر CommandLine = AppName & " -o " & OutputFile & " --rotate=0 --eci=24 --scale=2 -w 10 --height=100 --barcode=58 -d " & OutputText وهذا بالرجوع لمشاركه لاخى ومعلمى العزيز @jjafferr جزاه الله عنا كل خير بالتوفيق New.accdb

شكرا جزيلا أخي الفاضل وبارك الله فيك بحق هذه الأيام المباركة

تفضل استاذ @2saad المرفق بعد التعديل حسب مافهمت . 2استدعاء الغائب وله دور ثان-2.rar

ههههههههه اعلم انه صواب وكويس انك انتبهت انها قيم فارغه وليست 0 بالتوفيق

اخي الكريم انا طريقتي لا اضع سعر الشراء في تكويد الاصناف ولا سعر البيع اضع الصنف الكمية الافتتاحية - كم متوفر عنا بالمستودع والذي ستجري عليه عمليات الزيادة والنقصان من فواتير البيع والشراء اقصد برقم يدوي اني انا اختار في فاتورة المبيعات سعر البيع يدوي وفي فاتورة المشتريات سعر الشراء يدوي بمعنى اني لا استدعيه من الاصناف بالطريقة التقليدية هذه وجهة نظر وليست ملزمة لاحد

شكر خاص لك الاساتذة الافاضل للمساعدة فى الحلول التى تساعد

هذه الجداول الموجوده في القاعده حضرتك تقصد نقل سعر الشراء الي جدول الفاتورة ام في جدول الحركة وارجو من حضرتك ماذا تقصد برقم يدوي ؟

إليك كود VBA في Excel لتحقيق ذلك، مع شرح تفصيلي: شرح الكود المتغيرات: lastRow: لتحديد آخر صف يحتوي على بيانات في العمود A (يمكنك تغيير العمود حسب الحاجة). i: متغير يستخدم في حلقة التكرار للمرور على الصفوف. endDate: لتخزين تاريخ انتهاء العقد. daysRemaining: لحساب عدد الأيام المتبقية حتى انتهاء العقد. emailAddress: لتخزين عنوان البريد الإلكتروني للشخص المعني. messageBody: لتخزين نص الرسالة. حلقة التكرار: تكرر الحلقة على جميع الصفوف التي تحتوي على بيانات. تفترض أن تاريخ انتهاء العقد موجود في العمود B، وأن عنوان البريد الإلكتروني موجود في العمود C، ونص الرسالة موجود في العمود D. يمكنك تغيير هذه الأعمدة حسب الحاجة. يتم حساب عدد الأيام المتبقية حتى انتهاء العقد باستخدام الدالة DateDiff. إذا كان عدد الأيام المتبقية 60 يومًا أو أقل، يتم تنفيذ الخطوات التالية: جلب عنوان البريد الإلكتروني ونص الرسالة. استخدام CreateObject("Outlook.Application") لإرسال البريد الإلكتروني. تحديد عنوان المرسل إليه، الموضوع، ونص الرسالة. عرض البريد الإلكتروني أو إرساله مباشرةً. إرسال واتساب: تتطلب هذه الخطوة استخدام واجهة برمجة تطبيقات (API) خاصة بـ WhatsApp، حيث لا يوجد طريقة مباشرة لإرسال رسائل WhatsApp باستخدام VBA فقط. يمكنك استخدام خدمات مثل Twilio أو MessageBird أو غيرها لإرسال رسائل WhatsApp عبر API. يجب عليك التسجيل في إحدى هذه الخدمات والحصول على مفتاح API. يمكنك استخدام الدالة CreateObject("MSXML2.XMLHTTP") لإرسال طلب HTTP إلى API الخاص بـ WhatsApp. الكود ملاحظات: تأكد من تغيير أسماء الأعمدة في الكود لتتوافق مع بياناتك. لتفعيل إرسال الايميل يجب تفعيل المكتبة الخاصة ب outlook من قائمة tools ثم references ثم اختيار Microsoft outlook Object Library. لإرسال رسائل WhatsApp، ستحتاج إلى إضافة كود إضافي باستخدام API. يمكنك تخصيص نص الرسالة وموضوع البريد الإلكتروني حسب الحاجة. يمكنك جدولة تشغيل هذا الكود تلقائيًا باستخدام وظيفة "جدولة المهام" في Windows. إضافة كود لإرسال رسائل WhatsApp باستخدام API يتطلب بعض الخطوات الإضافية. إليك شرح لكيفية القيام بذلك باستخدام خدمة Twilio، وهي واحدة من الخدمات الشائعة التي توفر واجهة برمجة تطبيقات (API) لإرسال رسائل WhatsApp: 1. التسجيل في Twilio والحصول على مفتاح API: قم بزيارة موقع Twilio وقم بإنشاء حساب. بعد تسجيل الدخول، انتقل إلى وحدة تحكم Twilio واحصل على مفتاح API الخاص بك (Account SID وAuth Token). قم بتمكين WhatsApp في حساب Twilio الخاص بك. احصل على رقم هاتف Twilio يدعم WhatsApp. 2. إضافة مكتبة MSXML2: في محرر VBA، انتقل إلى "Tools" ثم "References". ابحث عن "Microsoft XML, v6.0" أو إصدار أحدث وقم بتحديده. 3. كود VBA لإرسال رسالة WhatsApp: Sub SendEmailOrWhatsApp() Dim lastRow As Long Dim i As Long Dim endDate As Date Dim daysRemaining As Long Dim emailAddress As String Dim messageBody As String lastRow = Cells(Rows.Count, "A").End(xlUp).Row ' تحديد آخر صف في العمود A For i = 2 To lastRow ' ابدأ من الصف الثاني (بافتراض أن الصف الأول هو رأس الجدول) endDate = Cells(i, "B").Value ' تاريخ انتهاء العقد في العمود B daysRemaining = DateDiff("d", Date, endDate) ' حساب الأيام المتبقية emailAddress = Cells(i, "C").Value ' عنوان البريد الإلكتروني في العمود C messageBody = Cells(i, "D").Value ' نص الرسالة في العمود D If daysRemaining <= 60 Then ' إرسال بريد إلكتروني Dim outlookApp As Object Dim outlookMail As Object Set outlookApp = CreateObject("Outlook.Application") Set outlookMail = outlookApp.CreateItem(0) With outlookMail .To = emailAddress .Subject = "تنبيه: انتهاء العقد" .Body = messageBody .Display ' أو .Send للإرسال مباشرةً End With Set outlookMail = Nothing Set outlookApp = Nothing ' إرسال واتساب (يتطلب استخدام API) ' يمكنك إضافة كود لإرسال واتساب هنا باستخدام API End If Next i End Sub Sub SendWhatsAppMessage(phoneNumber As String, messageBody As String) Dim xmlHttp As Object Dim accountSid As String Dim authToken As String Dim twilioNumber As String Dim url As String accountSid = "ACxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ' استبدل بـ Account SID الخاص بك authToken = "your_auth_token" ' استبدل بـ Auth Token الخاص بك twilioNumber = "whatsapp:+1xxxxxxxxxx" ' استبدل برقم Twilio الخاص بك phoneNumber = "whatsapp:+xxxxxxxxxxx" ' استبدل برقم هاتف المستلم url = "https://api.twilio.com/2010-04-01/Accounts/" & accountSid & "/Messages.json" Set xmlHttp = CreateObject("MSXML2.XMLHTTP") xmlHttp.Open "POST", url, False xmlHttp.setRequestHeader "Authorization", "Basic " & EncodeBase64(accountSid & ":" & authToken) xmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" xmlHttp.send "To=" & phoneNumber & "&From=" & twilioNumber & "&Body=" & EncodeUrl(messageBody) If xmlHttp.Status = 201 Then MsgBox "تم إرسال رسالة WhatsApp بنجاح!" Else MsgBox "فشل إرسال رسالة WhatsApp. الحالة: " & xmlHttp.Status End If Set xmlHttp = Nothing End Sub Function EncodeBase64(text As String) As String Dim arrData() As Byte arrData = StrConv(text, vbFromUnicode) Dim objXML As Object Dim objNode As Object Set objXML = CreateObject("MSXML2.DOMDocument") Set objNode = objXML.createElement("b64") objNode.DataType = "bin.base64" objNode.nodeTypedValue = arrData EncodeBase64 = objNode.text Set objNode = Nothing Set objXML = Nothing End Function Function EncodeUrl(text As String) As String Dim objXML As Object Set objXML = CreateObject("MSXML2.DOMDocument") EncodeUrl = objXML.createElement("url").appendChild(objXML.createTextNode(text)).ParentNode.innerHTML Set objXML = Nothing End Function

الف شكر لك ا / محمد هشام هذا هو المطلوب عمله