حسونة حسين

وعليكم السلام ورحمه الله وبركاته تفضل هذا الكود ( تعديل لكودك ) Sub ترحيل_البيانات() Dim Lr As Long, SH As Worksheet, WS As Worksheet Set SH = ThisWorkbook.Worksheets("تقرير الوردية اليومي") Set WS = ThisWorkbook.Worksheets("شيت مجمع") Application.ScreenUpdating = False If MsgBox("انت تريد ترحيل هذا الايصال . هل تريد الاستمرار ؟", vbYesNo + vbQuestion) = vbNo Then Exit Sub End If If SH.Cells(4, 3).Value <> "" Then With SH .Activate .Unprotect Password:="011005051002018" WS.Unprotect Password:="011005051002018" If WS.FilterMode Then WS.ShowAllData End If Lr = WS.Cells(Rows.Count, "G").End(xlUp).Row + 1 WS.Range("A" & Lr).Resize(4) = .Range("C4").Value WS.Range("A" & Lr).Resize(4).NumberFormat = "dd/mm/yyyy" WS.Range("B" & Lr).Resize(4) = .Range("E4").Value WS.Range("C" & Lr).Resize(4) = .Range("G4").Value WS.Range("D" & Lr).Resize(4) = .Range("I4").Value WS.Range("E" & Lr).Resize(4) = .Range("K4").Value WS.Range("F" & Lr).Resize(4) = .Range("N4").Value .Range("B7:M10").Copy WS.Range("G" & WS.Cells(Rows.Count, "G").End(xlUp).Row + 1).PasteSpecial xlPasteValues .Range("B13:P16").Copy WS.Range("S" & WS.Cells(Rows.Count, "S").End(xlUp).Row + 1).PasteSpecial xlPasteValues .Range("C4,G4,I4,K4,N4,D7:J10,L7:P10,D13:I16,L13:P16").ClearContents .Protect Password:="011005051002018", AllowFiltering:=True, AllowFormattingCells:=True Application.Goto WS.Range("C4") WS.Protect Password:="011005051002018", AllowFiltering:=True, AllowFormattingCells:=True End With Else MsgBox "الرجاء وضع التاريخ و ملئ البيانات" SH.Activate SH.Range("C4").Select Exit Sub End If Application.ScreenUpdating = True End Sub

يا اخى كيف لا يهم شكل التقرير وكل الاكواد تعتمد علي شكل التقرير ( المخرجات )

وعليكم السلام ورحمه الله وبركاته استبدل هذا السطر Kh_Path = ThisWorkbook.Path & "\photo\" & p بهذا السطر Kh_Path = ThisWorkbook.Path & "\photo\" & 1 على اعتبار ان 1 هو اسم الصورة الخاصه بالشعار

وعليكم السلام ورحمه الله وبركاته لانها بتاريخ 18-1-2023 وفترة الإستحقاق 60 يوم ولو طرحت تاريخ اليوم من تاريخ الفاتورة سوف تجده انه 54 يوم كده الفاتورة لم تستحق فكيف تظهر في التقرير وكنت قد كتبت لك ولكنك اكتفيت ايضا بذياده اعمده وتشغيل الكود فقط ولم تضع شكل النتائج وذلك لان فاتورة العميل رقم 4 الجديده لم اجدها في التقرير وايضا لا يوجد سداد نقدي لاي فاتورة

اخى @أحمد حجاج ما هو امتداد الملف حاول تعمل ريكفري للملف باي برنامج recover ايضا ابحث في فولدر ال temp

تم حل المشكله في هذا https://www.officena.net/ib/topic/118598-معادلة-جمع-بشروط/?_report=919#comment-715203

وعليكم السلام ورحمة الله وبركاته عدل هذا السطر Application.Match(Val(Target.Value), Columns(1), 0) الى Application.Match(Val(Target.Value), Columns(4), 0)

اخى هذا السؤال قد طرحته عليك مرارا ولم تجاوبني عليه صمم صفحه بها شكل النتائج يدوي

وعليكم السلام ورحمه الله وبركاته اخى الكريم @محمد حمدي وبالنسبه شكل النتائج المطلوبه يمكنك عملها يدوي لنرى كيف تريد النتائج لما تضعها مثل ماهو موجود في صفحه التقرير ام ماذا العملاء.xlsb

لا تكرر الكود لكن ضيف عليه الاعمده Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Dim X As Range For Each X In Target If X.Column = 2 Or X.Column = 4 Or X.Column = 18 Or X.Column = 20 Then If X.Row > 7 Then If X.Value = "" Then X.Offset(0, 1) = "" Else On Error Resume Next X.Offset(0, 1) = "" X.Offset(0, 1) = Now X.Offset(0, 1).NumberFormat = "dd-mm-yyyy HH:mm" End If End If End If Next Application.EnableEvents = True End Sub

يتم وضعه في حدث الورقه المسمار الوصل تضغط عليها كليك يمين ثم view code ثم تنسخ الكود وتضعه بها

فقط أضف رقم ١ للكود الموجود في تيكست بوكس ٦ لان المعادله المكتوبه تطرح الايام بين التاريخين ولكن الموظف غائب 9 ايام وليس ٨ 7,8,9,10,11,12,13,14,15 ليصبح الكود هكذا TextBox6 = Val(TextBox5) - Val(TextBox4) + 1

وعليكم السلام ورحمه الله وبركاته اضف هذا السطر Dim X: X = Application.Match(ComboBox1.Value, .Range("b1:b" & lr), 0): If Not IsError(X) Then lr = X قبل هذا السطر .Cells(lr, 2) = ComboBox1.Value ليصبح هكذا lr = .Cells(Rows.Count, 2).End(xlUp).Row + 1 Dim X: X = Application.Match(ComboBox1.Value, .Range("b1:b" & lr), 0): If Not IsError(X) Then lr = X .Cells(lr, 2) = ComboBox1.Value

وعليكم السلام ورحمه الله وبركاته تفضل Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Dim X If (Target.Column = 5 And Target.Row > 11) Then X = Application.Match(Target.Offset(0, -2), Sheet2.Range("C1:C" & Sheet2.Cells(Rows.Count, "C").End(xlUp).Row), 0) If Target.Value > Sheet2.Range("K" & X) Then MsgBox "noooooooooooooooo" Target.Value = "" Else Sheet2.Cells(X, 9).Formula = "=" & Sheet2.Range("I" & X) & "+" & Target.Value End If End If Application.EnableEvents = True End Sub

وعليكم السلام ورحمه الله وبركاته يمكنك ذلك بوضع زر امر علي اليوزرفورم ووضع هذا الكود به Private Sub CommandButton1_Click() If (TextBox1 <> "" And TextBox2 <> "" And TextBox3 <> "") Then TextBox4 = TextBox1 * TextBox2 * TextBox3 Else TextBox4 = "" End If End Sub

وعليكم السلام ورحمة الله وبركاته الكود موجود في موديل ١ انقله الي حدث الشيت سوف يعمل طبيعي عند أي تغيير للبيانات

وعليكم السلام ورحمة الله وبركاته قم بعمل مستخدم جديد للويندوز مثلا باسم احمد او محمد ثم قم بالدخول للويندوز عن طريق المستخدم الجديد وشغل ملفات الاكسل لو فتحت عادي بدون مشاكل يكون المشكله ليست في نسخه الاوفيس وإنما في اعدادات الاكسل في الريجسترى قم بخطوة المستخدم الجديد لو اشتغل سوف اجهز لك ملف لضبط اعدادات الاكسل

وعليكم السلام ورحمة الله وبركاته اخى هذا كود بسيط ليسهل عليك تعديله Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Dim X As Range For Each X In Target If X.Column = 2 Or X.Column = 4 Then ' العمود رقم 2 والعامود رقم 4 If X.Row > 7 Then 'رقم الصف اكبر من 7 If X.Value = "" Then X.Offset(0, 1) = "" Else On Error Resume Next X.Offset(0, 1) = "" X.Offset(0, 1) = Now X.Offset(0, 1).NumberFormat = "dd-mm-yyyy HH:mm" End If End If End If Next Application.EnableEvents = True End Sub

وعليكم السلام ورحمة الله وبركاته يمكنك رفع ملف وشرح ما هو مطلوب وصورة لشكل النتائج المطلوبه

وعليكم السلام ورحمة الله وبركاته اخى @محمد حمدي الكود يعمل جيدا عندي على الملف في المشاركه الأولى ولكنك أضفت اعمده أخرى لم تكن موجوده هل يمكنك شرح ما هو مطلوب لأنك لم تشرح لكنك أضفت اعمده وسطور اخرى فقط وبالنسبه شكل النتائج المطلوبه يمكنك عملها يدوي لنرى كيف تريد النتائج

في المشاركه الاولي للأستاذ @محمد حسن المحمد https://www.officena.net/ib/topic/118435-qrcode/?do=findComment&comment=714178

هذا خاص بالسجل المدنى وليست بطريق حسابيه

السلام عليكم ورحمة الله وبركاته وبها نبدأ اي موضوع تفضل لعله المطلوب العملاء.xlsb

اخى @محمد حسن المحمدالكود يعمل جيدا يتم تحديث ما يكتب في الخلايا ضمن QRCODE اوفيس 2010 وافيس 2021

وهل تضمن اخى ان دفعت ان يعطيك شيئ مما أخذه منك بالقوة انا لله وانا اليه راجعون