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

إليك كود 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

لا اعلم ان كان ما فهمته صحيح ، تفضل هذا الاستعلام ، وأخبرنا بالنتيجة ,, TRANSFORM Sum([Competitor Analysis].Premium) AS SumOfPremium SELECT [Competitor Analysis].clint_code FROM [Competitor Analysis] GROUP BY [Competitor Analysis].clint_code PIVOT [Competitor Analysis].company; test (1).accdb

تفضل فكرتي المتواضعة ، حيث سيتم أولاً تحميل أسماء الاستعلامات في الليست بوكس ، وانت تختار ما تريده ، ثم انقر الزر للتصدير :- Private Sub Export_Selected_Queries() Dim xlApp As Object, xlWorkbook As Object, xlWorksheet As Object Dim db As DAO.Database, rs As DAO.Recordset Dim sheetIndex As Integer, colIndex As Integer, rowIndex As Integer Dim filePath As String, queryName As String Dim i As Variant filePath = Application.CurrentProject.Path & "\تقرير_الاكسيل.xlsx" If Me.Que_List.ItemsSelected.Count = 0 Then MsgBox "يرجى تحديد استعلام واحد على الأقل قبل التصدير", vbExclamation + vbMsgBoxRight, "خطأ" Exit Sub End If Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True Set xlWorkbook = xlApp.Workbooks.Add Set db = CurrentDb sheetIndex = 1 For Each i In Me.Que_List.ItemsSelected queryName = Trim(Me.Que_List.ItemData(i)) Set rs = db.OpenRecordset(queryName, dbOpenSnapshot) If sheetIndex <= xlWorkbook.Sheets.Count Then Set xlWorksheet = xlWorkbook.Sheets(sheetIndex) Else Set xlWorksheet = xlWorkbook.Sheets.Add End If xlWorksheet.Name = queryName colIndex = 1 With xlWorksheet For Each fld In rs.Fields .Cells(1, colIndex).Value = fld.Name .Cells(1, colIndex).Font.Bold = True colIndex = colIndex + 1 Next fld rowIndex = 2 Do While Not rs.EOF colIndex = 1 For Each fld In rs.Fields .Cells(rowIndex, colIndex).Value = fld.Value colIndex = colIndex + 1 Next fld rowIndex = rowIndex + 1 rs.MoveNext Loop End With rs.Close sheetIndex = sheetIndex + 1 Next i xlWorkbook.SaveAs filePath xlWorkbook.Close xlApp.Quit On Error Resume Next Set rs = Nothing Set db = Nothing Set xlWorksheet = Nothing Set xlWorkbook = Nothing Set xlApp = Nothing On Error GoTo 0 MsgBox "تم تصدير البيانات بنجاح", vbInformation + vbMsgBoxRight, "نجاح العملية" End Sub test.accdb

حبيب نزل طلبك في منشور منفصل وستجد الرد الشافي والوافي من الخبراء

هذا يعني أنه لن يكون عليه إدخال الأصناف بفواتير شراء ، وما يترتب عليه عدم الحصول على أرباح أو ضبط الأمور المالية للأرباح والخسائر.... إلخ. أيضاً يعني أنه عند عملية كل بيع وفاتورة بيع ، سيكون عليك ادخال سعر الشراء والبيع بشكل يدوي .. وشوف انت لو لخبطت الدنيا بفاتورة وحدة بعد ما تحفظها 😅 . وجهة نظر غير ملزمة 😇 .

بعد المحاولة والتجربة خرجت بالنتائج التالية : 1- اي عملية حجز يراد التعديل عليها أو تحديثها الأفضل ان يتم الغاؤها .. اي حجبها فلا تظهر في بحث الحجز .. سواء كان القصد استبدال الزبون او تغيير وقت الحجز . 2- الإلغاء او الحجب عبارة عن حقل نعم/ لا يتم تفعيله عند الإلغاء بعد حجب الموعد : البديل الجديد او الزبون الذي يريد تغيير وقت الحجز يتم تسجيل حجز جديد له في المرفق ادناه : نموذج خاص بالإلغاء لن تظهر الملاحظات الا بعد التجربة المكثفة مواعيد دخول وخروج3.rar

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

وعليكم السلام ورحمة الله وبركاته.. سؤال على الهامش لصاحب الموضوع ، لو كنت بعت المروحة دي بسعر الشراء السابق ولنفرض 1100 ، وبعد يومين ارتفع سعرها ولكن انت اشتريتها لنفترض 900 ، وعندك عدد لنفترض 10 قطعة من السعر 900 ( لم يتم بيعها ) ، وجئت بعد 3 ايام واشتريت عدد 12 قطعة بالسعر الجديد 1050 . الآن لديك سعري شراء لمنتج 1 ، فبأي السعرين ستبيع ؟؟؟؟؟ وفيما يتعلق بموضوع الربح كيف سيفهم برنامجك أنك بعت الصنف نفسه بالسعر القديم أو الجديد ليحدد لك هامش الربح ؟؟؟ لذا توجه الى اسم الصنف مثلاً مروحة سقف تورنيدو سعر1 أو ... سعر2 ... أو سعر 3 . مع استخلاص الكمية الأخيرة لكل صنف حتى تعلم كم الباقي منه .... الخ ولاحظ انك عند شراء الصنف بالسعر الجديد سيتم إدخاله بفاتورة شراء جديدة . هذا رأيي وغير ملزم 😇 .

استاذ @gavan رجاء راجع التعديل ورد عليا بأسرع وقت لأني أنسى واضطر لمراجعة المرفق من الأول ... تفضل المرفق . GavanDB.rar

ههههههههههههه , كود شبرين و نص مشكور يالغالي , بس ممكن اعطاء كود لفتح النموذج او النماذج في البرنامج , في مختلف الشاشات ؟ بمعنى لدي برنامج موسس على شاشة 15.6 , واعطيتها للعملاء احدهم دقة شاشتة 14 و الاخر 17 و الاخر 23 , هل سيفي بالغرض , حيث استعملت اكواد كثيرة في ChatGpt ولم اصل الى المطلوب تحياتي

اهلاً وسهلاً بك أستاذ @ahmedha سعداء بوجودك بيننا ... تفضل ضع هذا الكود عند التحميل . Private Sub Form_Load() Me.InsideHeight = (Me.Detail.Height * Me.Recordset.RecordCount) + Me.FormHeader.Height + Me.FormFooter.Height End Sub DDAhmedHa-Test.rar

waterbill.accdb