حسونة حسين

وعليكم السلام ورحمه الله وبركاته ارفق ملف به وليكن 50 بيان في الشيت رقم 1 و 100 بيان في الشيت رقم 2 ملف معبر عن ما تحتاج اليه حتي لا تضيع وقت الاخوة وتجد مبتغاك

وعليكم السلام ورحمه الله وبركاته اجعل الكود بهذا الشكل Sub Test() With Range("E5") .Value = Range("D5") / Range("C5") .NumberFormat = "0.0000%" End With End Sub

وعليكم السلام ورحمه الله وبركاته جرب هذا التعديل العملاء 2.xlsb

ويوجد هنا موضوع جميل للأستاذ @إبراهيم ابوليله لعلك تجد فيه ما تبغي

وعليكم السلام ورحمه الله وبركاته تفضل هذا كتاب Excel_2016__Power_Programming_with_VBA وهذا كتاب Excel_2019_Power_Programming_with_VBA الكتب باللغه الانجليزيه

وعليكم السلام ورحمة الله وبركاته تفضل رابط به مجموعه برامج جاهزه

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

وعليكم السلام ورحمه الله وبركاته تفضل هذا الكود ( تعديل لكودك ) 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