أبو حنــــين

السلام عليكم اخي محمود جرب هذا التعديل سعد عابد 4.rar

جرب هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 3 Or Target.Column = 4 And Target <> "" Then _ Cells(Target.Row, 2) = Application.WorksheetFunction.Subtotal(3, Range("$B:$B")) End Sub

اخي يوسف جرب المرفق التالي سيارات 2.rar

السلام عليكم اخي محمود الخطأ كان في الخلية المدمجة في السطر Last = .Cells(Rows.Count, "D").End(xlUp).Row + 1 و لتصحيح الخطأ غير فقط السطر السابق بالسطر التالي Last = .Cells(Rows.Count, "G").End(xlUp).Row + 1 اي وضعنا الحرف G بدل الحرف D

السلام عليكم وجدت 45 اسم فقط مشابهة للعمود الأول تجربة.rar

ربما طريقتك اخي وليد احسن من الطريقة التي قمت بها لان يومي الأربعاء و الأحد يظهران بنفس الطريقة اي بالحرف ( أ )

للفائدة يمكن ايضا استعمال هذه الطريقة =MID(TEXT(DAY(C2);"ddd");3;1)&DAY(C2)

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

جزاك الله خيرا اخي ابو أُمَيْمَة

السلام عليكم جرب هذا التعديل Sub saad() Application.ScreenUpdating = False Sheets("Entry").Select al = Sheets("Database").[e10000].End(xlUp).Row If [d1] = "" Or [d2] = "" Or [d3] = "" Then MsgBox "أكمل البيانات أولا" Exit Sub ElseIf Not [c4].Value = [d4].Value Then MsgBox "تأكد من ادخال القيد مع توازن الطرفين", vbExclamation, "ادخال خاطئ" Exit Sub ElseIf Sheets("Database").Range("e" & al).Value = [d2].Value Then MsgBox "تأكد من عدم تكرار القيد", vbExclamation, "ادخال خاطئ" Exit Sub End If If MsgBox("هل تريد ترحيل البيانات الحالية", vbInformation + vbOKCancel, "ترحيل") = vbCancel Then Exit Sub With Sheets("Entry") R_C = .Cells(Rows.Count, "C").End(xlUp).Row: R_D = .Cells(Rows.Count, "D").End(xlUp).Row R_E = .Cells(Rows.Count, "E").End(xlUp).Row: R_F = .Cells(Rows.Count, "F").End(xlUp).Row R_Row = Application.WorksheetFunction.Max(R_C, R_D, R_E, R_F) End With For R = 7 To R_Row With Sheets("Database") Last = .Cells(Rows.Count, "D").End(xlUp).Row + 1 Sheets("Entry").Range("C" & R).Resize(1, 4).Copy .Range("G" & Last).PasteSpecial xlPasteValues: .Range("D" & Last) = Sheets("Entry").Range("D1").Value .Range("E" & Last) = Sheets("Entry").Range("D2").Value: .Range("F" & Last) = Sheets("Entry").Range("D3").Value Last = Last + 1 End With Next With Sheets("Database") Last1 = .Cells(Rows.Count, "D").End(xlUp).Row .Range("D" & Last1 & ":J" & Last1).Borders.Value = 1 .Range("D" & Last1 & ":J" & Last1).Borders(xlEdgeTop).LineStyle = xlNone .Range("D" & Last1 & ":J" & Last1).Borders(xlEdgeBottom).Weight = xlThick .Range("D" & Last1 & ":J" & Last1).Borders(xlEdgeBottom).ColorIndex = 3 End With With Sheets("Entry") MsgBox "تم ترحيل بيانات السند رقم " & .Range("D2") & " بنجاح", vbInformation, "ترحيل" .Range("C7:F40") = "" .Range("D1:D3") = "" End With Application.ScreenUpdating = True Application.CutCopyMode = False End Sub

السلام عليكم جرب هذه الطريقة قم بنسخ هذا الكود في ورقة العمل ثم غير في خلية التاريخ و خلية الدرجة الحالية Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 Or Target.Column = 3 Then If CStr(Cells(Target.Row, 3)) = CStr(Cells(Target.Row, 15)) Then Exit Sub Else Application.DisplayAlerts = False Range(Cells(Target.Row, 2), Cells(Target.Row, 9)).Copy Cells(Target.Row, 4) Range(Cells(Target.Row, 12), Cells(Target.Row, 15)).ClearContents End If End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 2 Or Target.Column = 3 Then Cells(Target.Row, 14).Value = Cells(Target.Row, 2).Value Cells(Target.Row, 15).Value = Cells(Target.Row, 3).Value End If End Sub

السلام عليكم الاخوة الاحباء الافاضل : ابراهيم حمادة إسلام أحمد جزاكم الله خيرا على المرور وبورك فيكم

السلام عليكم بالنسبة لخطأ الترحيل غير هذا السطر For r = 7 To Sheets("Entry").[c40].End(xlUp).Row بهذا السطر For r = 7 To Sheets("Entry").UsedRange.Rows.Count

اخي عادل جزاك الله خيرا بالفعل لكل اختصاصه و انا لو دخلت بين الدائن و المدين اتوه و يصبح رصيدي صفر ، خليني امشي بحركة مستقيمة و بسرعة ثابة لكي لا ينقص تركيزي جزاكم الله خيرا

اخي سعد جرب المرفق 2007 كسف حساب 2007.rar

اخي : وليد فتحي اخي : احمد مجدي جزاكم الله خير الجزاء

أخي عادل السلام عليكم و الله ما مكوثنا اما الحاسوب لساعات طويلة الا سعيا لرفع الرصيد من مدين الى دائن ( هههههههه ) و ذلك لكسب مثل هذا الدعاء الطيب اثابكم الله و جزاكم كل الخير

السلام عليكم اخي سعد سارفع الملف باصدار 2007 و جرب ان عمل معك او لا و لقد ورد في حديثك الجملة التالية : انت بالمصرى فتحت على نفسك باب لابد ان تتمه ان شاء الله و انا اجيبك بالمصري : الباب الى يجيلك منه الريح سدو و استريح انها مجرد مزحة فقط و سأعمل ما يمكن عمله لكن بتوجيه من اصحاب الاختصاص تقبل تحياتي

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

أخي وليد فتحي جزاكم الله خيرا على المرور

هذا هو الملف اخي اكرم يحتوي على واجهة للبحث السريع بالاسم او الحرف يحتوي على واجهة اخرى اخذت قاعدة بياناتها من هذا المنتدى لترجمة الاسماء من العربية للانجليزية الملف باصدار 2003 بحث.rar

السلام عليكم رأيت الاخوة يتكلمون على كشف الحساب و من خلال ما فهمت منهم وضعت هذا النموذج و لا ادري مدى صحته و بكل صدق ليس لي أي علاقة بالمحاسبة و لا اعرف لها عنوانا و لا سكنا و لا هاتفا ، و حتى بالشكل لا اعرفها . . ( اخوكم غريب ) . و ربما الهدف من رفع هذا المثال هو طريقة البحث التي ارى انها ممتعة و سلسة يمكن ان يُستفاد منها ملاحظة الملف اصدار 2003 كشف حساب.rar

جزاك الله خيرا اخي زمزم هذا هو الملف بعد وضع الكود بداخله لم اقم سوى بوضع الكود في موديل و لم اقم بأي تغيير الأعداد الأولية.rar

السلام عليكم مثلا عندما نريد تشغيل الحاسبة نكتب Private Sub CommandButton1_Click() Dim MYCALC MYCALC = Shell("CALC.EXE") End Sub

الحمد لله و الشكر موصول للجميع و لكل من ساهم او عقب على هذا الموضوع بارك الله فيكم جزاك الله خيرا