الـعيدروس

السلام عليكم اذا الى خيارات اكسل ثم خيارات متقدمة اتبع الصورة

السلام عليكم وماهيا المشكلة لابد من توضيح بارك الله فيك

السلام عليكم بالامكان حسب فهمي لطلبك بكود حدث الصفحة كالتالي ' استبدل مدى الاعمدة حسب مدى بيانات الكنترول لديك Private Const Adrss = "A:Z" Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range(Adrss)) Is Nothing Then With Target .Offset(0, 1).Select If Split(Adrss, ":")(1) = Split(.Address, "$")(1) Then Range(Split(Adrss, ":")(0) & .Row + 1).Select End If End With End If End Sub

السلام عليكم شاهد هذا التعديل Petty Cash Excel _Ali3.xlsm

هذا اعتقد موجود عند الطباعه لايطبع الا المدى الذي به بيانات او لك طلب اخر ان باقي صفوف الجدول تختفي فقط بغير الطباعه ؟ بمعنى عند البحث عن كود مثلاً PC-002 النتائج سطر فقط وبه الاجمالي مثل ميزان المراجعه تقصد او تكرار عادي حسب الموجود فقط يستدعي عمود الاجمالي ككشف حساب تفصيلي

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

الخلايا ذات الالوان المتدرجه لم تعمل مع الكود فهمتني اما الخلايا التي بها لون عادي بتعمل بكفاءه لي محاولات بالتعديل على الكود اذا نجحت سأرفقها

جرب المرفق بالمشاركة السابقة

السلام عليكم ابشر بعدلك عليه فعلاً هذا مايظهر جرب المرفق Petty Cash Excel _Ali2.xlsm

السلام عليكم خطأ فقط استبدل + بعلامة الفاصله المنقوطة ; واذا كان لديك بالويندوز الفاصلة العاديه استخدمها , معادلة S15 =MOD( SUM( H6;J6;L6;N6;P6;D9;F9;H9;J9;L9;N9;P9;D12;F12;H12;J12;L12;N12);100) معادلة T15 =SUM(I6;K6;M6;O6;Q6;E9;G9;I9;K9;M9;O9;Q9;E12;G12;I12;K12;M12;O12)+INT(SUM(H6;J6;L6;N6;P6;D9;F9;H9;J9;L9;N9;P9;D12;F12;H12;J12;L12;N12)/100)

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

السلام عليكم الخلايا التي بها الوان متدرجه لايجدي الكود معها لاكن بخصوص اختلاف ارجاع الالوان كما سابقتها بالامكان تصحيحه بالتعديل على الكود ليصبح كالتالي Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) MyColor = 6 If Not IsError(Sh.[N_Color_Rng]) Then If Not IsError(Sh.[N_Color_Color]) Then If Not IsError(Sh.[N_Color_Old]) Then If Sh.[N_Color_Rng].Interior.ColorIndex = Sh.[N_Color_Old] Then Dim R, G, B R = Ref_Ali(Sh.Names("N_Color_Color").RefersToR1C1, 1) G = Ref_Ali(Sh.Names("N_Color_Color").RefersToR1C1, 2) B = Ref_Ali(Sh.Names("N_Color_Color").RefersToR1C1, 3) Sh.[N_Color_Rng].Interior.Color = RGB(R, G, B) End If End If End If End If Sh.Names.Add "N_Color_Rng", ActiveCell Sh.Names.Add "N_Color_Color", G_Colr(ActiveCell) Sh.Names.Add "N_Color_Old", MyColor ActiveCell.Interior.ColorIndex = MyColor End Sub Function Ref_Ali(a, Inx) Select Case Inx Case 1 aa = Mid(a, InStr(1, a, "(") + 1, InStr(InStr(1, a, "("), a, ",") - InStr(1, a, "(") - 1) Case 2 aa = Split(a, ",")(1) Case 3 aa = Mid(Trim(Split(a, ",")(2)), 1, InStr(1, Trim(Split(a, ",")(2)), ")") - 1) End Select Ref_Ali = aa End Function Function G_Colr(Rng As Range) Dim HEX_A As String Dim Ali_R As String HEX_A = Right("000000" & Hex(Rng.Interior.Color), 6) Ali_R = "RGB (" & CInt("&H" & Right(HEX_A, 2)) & ", " & CInt("&H" & Mid(HEX_A, 3, 2)) & ", " & CInt("&H" & Left(HEX_A, 2)) & ")" G_Colr = Ali_R End Function

السلام عليكم تفضل D_n.xlsm

السلام عليكم شاهد المرفق احد اكواد الاستاذ الخالدي حفظه الله ورعاه كنترول صف خامس.xlsm

السلام عليكم اضن تنفيذك خطأ فقط جرب المرفق ترقية العدد1.xlsm

السلام عليكم جرب هكذا Me.TextBox3.Text = Math.RoundUp(Val(TextBox1.Text) - Val(TextBox2.Text), 0)

السلام عليكم تفضل المرفق بيان الحالة1.xlsm

اخي الحبيب سعد عابد اشكرك على مرورك وكلماتك الطيبه

السلام عليكم اخ امجد بارك الله فيك على كلماتك الطيبه جرب المرفق بخصوص كشف الحساب Petty Cash Excel _Ali1.xlsm

اخي الكريم حط مسار المجلد الرئيسي الذي ذكرته بهذا السطر pth1 = ThisWorkbook.Path & "\" فليكن مثلاً "C:\Users\aad\Desktop" يكتب بالمتغير كالتالي pth1 = "C:\Users\aad\Desktop" & "\"

اذا كان بنفس مسار الملف الذي به الكود Private Sub CommandButton1_Click() Dim pth, Nm, Pt, pth1 pth = "D:\my_f\" pth1 = ThisWorkbook.Path & "\" Nm = Me.ComboBox1.Value & ".*" Ar = Array(pth, pth1) For Each Pt In Ar If Dir(Ar & Nm, vbDirectory) = "" Then MsgBox "لايوجد ملف بنفس الاسم بالمسار المحدد لحذفه" & Pt Else Kill Ar & Nm & ".*" MsgBox "تم حذف الملف بنجاح من المسار" & " :" & Pt End If Next Pt End Sub

روح للمجلد الذي بالمسار وانسخ المسار وحطه في المتغير pth = "D:\my_f\" ولاتنسى تحط علامة "\" في نهاية المسار

السلام عليكم بهذا الكود Private Sub CommandButton1_Click() Dim pth, Nm pth = "D:\my_f\" Nm = Me.ComboBox1.Value & ".*" If Dir(pth & Nm, vbDirectory) = "" Then MsgBox "لايوجد ملف بنفس الاسم بالمسار المحدد لحذفه" Else Kill pth & Nm & ".*" MsgBox "تم حذف الملف بنجاح" End If End Sub

مافهمت الاكسل لايقبل او ماذا

السلام عليكم جرب المرفق فورم المبالغ المستلمة و فورم ارشيف العهد كشف الحساب سأعمل عليه لاحقا في امان الله Petty Cash Excel _Ali.xlsm