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

مشاركة مع اخي فادي للفائدة العامة مشروع تأجير المركبات : 1- تكون المركبة هي رأس الهرم في المشروع ، اما العميل فهو فرع سبب بسيط بديهي : المركبة يتناوب عليها الكثير من العملاء وقد يستأجرها عميل طارىء مرة واحدة فقط المركبة هي المصدر المالي للمشروع ويجري عليها العمليات المختلفة : تحصيل اجور/ نفقات صيانة / تأمين / مبالغ للوقود / اجرة سائق ان وجد ..... الخ

وعليكم السلام ورحمة الله تعالى وبركاته الكود الخاص بك يستخدم Application.FileSearch والذي كان مدعوما في Excel 2003 ولكن تم إيقاف دعمه في الإصدارات الأحدث من Excel أعتقد مند 2007 وبالتالي يتطلب تعديلات ليعمل على الإصدارات الأحدث جرب هدا Private Sub TamamUpdate() Dim val As String, Namey As String, file As String ComboBox28.Clear If OptionButton1.Value = True Then val = ThisWorkbook.Path & "\تمام\مدينة\" ElseIf OptionButton2.Value = True Then val = ThisWorkbook.Path & "\تمام\أكثر\" End If file = Dir(val & "*.xls*") Do While file <> "" Namey = Left(file, InStrRev(file, ".") - 1) ComboBox28.AddItem Namey file = Dir Loop End Sub بطريقة أخرى الكود التالي يؤدي نفس المهمة ولكنه يوفر للمستخدم خيار تحديد المجلد الذي سيتم البحث فيه الكود الخاص بك كان يعتمد على اختيار المجلد بناء على الاختيارات OptionButton1 و OptionButton2 بينما هذا الكود يسمح للمستخدم بتحديد المجلد يدويا باستخدام FileDialog Private Sub TamamUpdate() Dim val As String, Namey As String Dim fd As FileDialog, tmps As String Set fd = Application.FileDialog(msoFileDialogFolderPicker) If fd.Show = -1 Then tmps = fd.SelectedItems(1) Else Exit Sub End If ComboBox28.Clear val = tmps & "\" file = Dir(val & "*.xls*") Do While file <> "" Namey = Left(file, InStrRev(file, ".") - 1) ComboBox28.AddItem Namey file = Dir Loop End Sub RUN-v2.xls

وعليكم السلام ورحمة الله وبركاته .. بدايةً لن أنصحك بالإعتماد على كود تخطي الأخطاء هذا بشكل أساسي في مشاريعك ، لأنه قد يترتب عليه تخطي خطأ باكمال معلومة أو معادلة أو إجراء أو نتيجة ستكون قد بنيت عليها إجراءات أخرى ، وعليه تقع في مشاكل .. - على العموم استخدم الكود في حدث عند التحميل للنموذج ، وسيبقى مفعلاً لكل الأكواد الأخرى داخل النموذج طالما لم يتم تغييره في أي إجراء آخر . - أولاً لم أقم بتجربتها ، جرب استعماله في حدث On Error للنموذج كإجراء عام .

جرب هذا الكود تحليل الكود: يقوم الكود بحساب مدة الالتزامات بناءً على شهور البداية والنهاية الموجودة في ورقة عمل Excel، ثم يحسب المدة الإجمالية والمتبقية. الخطوات: تحديد ورقة العمل: يتم تحديد ورقة العمل المسماة "Sheet1" (يمكنك تغييرها حسب الحاجة). حساب مدد الالتزامات: يتم المرور على كل صف في العمود "A" (بدءًا من الصف الثاني). يتم استخراج شهور البداية والنهاية من العمودين "D" و "F" على التوالي. يتم حساب المدة لكل التزام (شهر النهاية - شهر البداية + 1) وتخزينها في العمود "H". يتم حساب المدة الإجمالية لكل الالتزامات. حساب المدة المتبقية: يتم حساب المدة المتبقية بطرح المدة الإجمالية من 240. كتابة النتائج: يتم كتابة المدة الإجمالية والمدة المتبقية في الصفوف التالية لآخر صف مستخدم في العمود "A". رسالة تأكيد: يتم عرض رسالة تأكيد للمستخدم. Sub RoundedRectangle6_Click() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim totalDuration As Long Dim remainingDuration As Long Dim startMonth As Long Dim endMonth As Long ' تحديد ورقة العمل Set ws = ThisWorkbook.Sheets("Sheet1") ' استبدل "Sheet1" باسم ورقة العمل الخاصة بك ' حساب مدد الالتزامات lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row For i = 2 To lastRow startMonth = Val(ws.Cells(i, "D").Value) endMonth = Val(ws.Cells(i, "F").Value) ws.Cells(i, "H").Value = endMonth - startMonth + 1 totalDuration = totalDuration + ws.Cells(i, "H").Value Next i ' حساب المدة المتبقية remainingDuration = 240 - totalDuration ' كتابة المدة الإجمالية والمدة المتبقية ws.Cells(lastRow + 2, "A").Value = "المدة الإجمالية:" ws.Cells(lastRow + 2, "B").Value = totalDuration ws.Cells(lastRow + 3, "A").Value = "المدة المتبقية:" ws.Cells(lastRow + 3, "B").Value = remainingDuration ' رسالة تأكيد MsgBox "تم إنشاء الجدول وحساب المدد." End Sub

مشاركة مع الإخوة والأساتذة ، جرب استعلام التوحيد Query1 التالي :- SELECT tip.ID, tip.nam, '2024' AS MissedYear FROM tip WHERE tip.ID NOT IN (SELECT Tshy.id FROM Tshy WHERE Tshy.yearshy = '2024') UNION SELECT tip.ID, tip.nam, '2025' AS MissedYear FROM tip WHERE tip.ID NOT IN (SELECT Tshy.id FROM Tshy WHERE Tshy.yearshy = '2025'); سيعرض لك السنة التي لم يدفع فيها العميل قسطه السنوي .. جرب وأخبرنا بالنتيجة ,, test.accdb

وعليكم السلام ورحمة الله تعالى وبركاته جرب هل هدا ما تقصده Option Explicit Dim tmps As Object, cell As Range Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error GoTo ClearApp If Target Is Nothing Then Exit Sub With Me.Shapes("CheckBox1").ControlFormat If .Value = xlOff Then Exit Sub End With If tmps Is Nothing Then Set tmps = CreateObject("Scripting.Dictionary") If Target.Cells.Count > 1 Then Exit Sub For Each cell In Target If Not Intersect(cell, Me.Range("A1:P40")) Is Nothing Then tmps(cell.Address) = cell.Value Next cell ExitHandler: Exit Sub ClearApp: Set tmps = Nothing Resume ExitHandler End Sub Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo ClearApp If Target Is Nothing Or tmps Is Nothing Then Exit Sub With Me.Shapes("CheckBox1").ControlFormat If .Value = xlOff Then Exit Sub End With If Target.Cells.Count > 1 Then Exit Sub Application.EnableEvents = False For Each cell In Target If Not Intersect(cell, Me.Range("A1:P40")) Is Nothing And tmps.exists(cell.Address) Then If IsNumeric(cell.Value) Then cell.Value = tmps(cell.Address) + cell.Value Else MsgBox cell.Address & " : " & "تم إدخال قيمة غير صالحة في الخلية ", vbExclamation End If End If Next cell ExitHandler: Application.EnableEvents = True Exit Sub ClearApp: Resume ExitHandler End Sub جمع الخلية v3.xlsb

استاذ @فؤاد الدلوي هل هذا ماتبحث عنه .... ادخل سنة البحث 2025 وطالع الناتج .. ووافني بالرد . test-111.rar

هذا يعني أن السجل 1 ، دفع في 2024,2025 على سبيل المثال ، صحيح ؟؟؟؟ أعتقد ان طريقة بنية الجدول والسجلات ستربك لاحقاً الاستعلام عند كثرة السجلات وزيادة البيانات 😵 !!!!

اخي حسب الجدول فإن السجلات التي أشرت لها لا علاقة لها بالدفع خلال السنوات المعنية 2024-2025 ملاحظة : في نظري فيه نقص في ملء سجل البيانات

كما ذكر اخي @Foksh صورة او ورقة اكسل وتكتب كل العناوين فيها وجعلها بدل مربعات النص او ورقة وورد

وباعتقادي ان الحل المقترح من الأستاذ @Moosak ، هو الأنسب لك ولمشكلتك ، بغض النظر عن اتجاه النص ( لا اعتقد انه يمثل مشكلة كبيرة ) الا اذا اردت الإستغناء عن مربعات النص بصورة لكل حقل بحيث تكتب صورة وترفقها في التقرير بدلاً من المربع النصي !!!

بدون الحاجة لأي تدخل برمجي أعتقد أنه بإمكانك إعادة تنسيق وتظبيط تنسيق التقرير وتضغير الحقول والخطوط لتلائم حجم ال A4 مباشرة 🙂 وهذه تجربتي : base_A.accdb

السلام عليكم ورحمة الله تعالى وبركاته ضع الصيغة التالية في الخلية (E6) مع سحبها للاسفل =IFERROR(INDEX($J$6:$J$11,MATCH(TRUE,MMULT(--(ROW($J$6:$J$11)>=TRANSPOSE(ROW($J$6:$J$11))),$I$6:$I$11)>=ROWS($1:1),0)),"") في حالة الرغبة بتسلسل عمود المدة بقدر بيانات عمود المبلغ في الخلية (F6) مع سحب المعادلة للاسفل =IF(E6<>"",ROWS($A$1:A1),"") Book1.xlsx

Try this code Sub Test() Const SROW As Long = 6 Dim w, m As Long, r As Long, n As Long Application.ScreenUpdating = False With ActiveSheet .Columns("L:M").ClearContents m = SROW For r = SROW To .Cells(Rows.Count, "J").End(xlUp).Row n = .Cells(r, "I").Value If n > 0 Then .Cells(m, "L").Resize(n).Value = .Cells(r, "J").Value m = m + n End If Next r m = m - SROW w = Evaluate("ROW(1:" & m & ")") .Range("M" & SROW).Resize(UBound(w, 1)).Value = w End With Application.ScreenUpdating = True End Sub