أبو حنــــين

جزاكم الله خيرا أخي محمد الريفي

أخي ياسر خليل و الذي نفسي بيده اني ابادلك نفس الشعور احبك الذي احببتني من اجله جزاكم الله خيرا و حفظكم و رعاكم

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

تفضل اخي المرفق QQQ1.rar

اضغط على Search باليمين ثم اختر تعيين ماكرو واتبع الخطوة الثانية كما في الصورة 1 و 2 المرفقتين 1.rar

اسعدت صباحا اخي الحبيب : أبو سليمان و الله اشتقنا لكم و لكل الاخوة اخي وائل الرسالة غير واضحة و لكن اعتقد حسب ما قرأت منها بعض الاحرف انك لم تقم بتمكين وحدات الماكرو ان كان لديك الاصدار 2007 من القائمة الرئيسية ----> خيارات ------> مركز التوثيق ----> اعدادات مركز التوثيق -----> اعدادات الماكرو ------> ثم تختار تمكين كافة وحدات الماكرو

بعد اذن اخي ابو عيد جرب المرفق Balance leaves. 2016.rar

كملاحظة يمكن ان نعرف ارقام الالوان بطرق مختلفة ابسطها : Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Interior.ColorIndex = xlColorIndexNone Then Exit Sub Target.Value = Target.Interior.ColorIndex End Sub حيث نقوم بتلوين خلايا مختلفة ثم نقف عند الخلية لنعرف ColorIndex

السلام عليكم اذا كانت ارقام الالوان معروفة مسبقا ( ColorIndex ) يمكن ان نستعمل الطريقة التالية Private Sub CommandButton1_Click() x1 = 3: x2 = 6 Dim cel As Range For Each cel In Range("d7:j7") If cel.Interior.ColorIndex = x1 Then r1 = r1 + cel.Count If cel.Interior.ColorIndex = x2 Then r2 = r2 + cel.Count Next Range("k7") = r2 Range("l7") = r1 End Sub

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

ضع في الخلية M2 الإسم مثل العليا و في الخلية L2 طريقة الدفع مثل نقدا و في الخلية K2 نوع العملية مثل جديد ثم في اي خلية أخرى تختارها أكتب الدالة التالية : =SUMPRODUCT(--($D$2:$D$21=M2);--($A$2:$A$21=K2);--($G$2:$G$21=L2);--($F$2:$F$21))

و عليكم السلام و رحمة الله و بركاته مرحبا بك اخي

مرحبا و الله رائع جدا اما بالنسبة لاخونا ابو البراء فأعتقد انه كان يريد كسر الباب و ليس فتحه و هذا حسب الفيديو الذي نشره ، يمكن ضيع المفتاح مثل بعض الناس إلي تضيع كلمات مرورها في المنتديات تقبلو فائق احترامي و تقديري

السلام عليكم اذا كانت كل القيم بنفس الصيغة يمكن استعمال الطريقة التالية TextBox1 = Left(TextBox1, 2) & "." & Mid(TextBox1, 2, 6) & "," & Mid(TextBox1, 6, 2) & "." & Right(TextBox1, 6)

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

يصبح الكود بهذا الشكل hanouf-TEST2.zip

اخي عبد العزيز اخي ابو البراء جزاكم الله خيرا

السلام عليكم جرب اخي المرفق Workbook1.zip

السلام عليكم استعمل اخي هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 14 And Target.Row > 2 Then If IsDate(Target.Value) = True Then For i = 1 To 9 Target.Offset(, i) = DateAdd("m", i, Target.Value) Next End If End If End Sub عندما تكتب التاريخ ، باقي التواريخ تسجل تلقائيا

أخي عبذ العزيز عمل رائع و الفكرة اروع جزاك الله خيرا

السلام عليكم اجبت على نصف السؤال حسب فهمي للموضوع برنامج حسابات لشركات الدعاية 1والإعلان.rar

مرحبا جرب هذا الكود Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, "FT")).Copy Range(Cells(ActiveCell.Row + 1, 1), Cells(ActiveCell.Row + 1, "FT")).Insert Shift:=xlDown End Sub

For x = 1 To Range("B" & Rows.Count).End(xlUp).Row السلام عليكم اخي وائل الخطأ كان في النقطة في هذا السطر For x = 1 To Range("B" & .Rows.Count).End(xlUp).Row تحذف فقط النقطة الموجودة بجانب الكلمة : Rows.Count فيصبح هكذا For x = 1 To Range("B" & Rows.Count).End(xlUp).Row

Sub AAAAAAAAA() Application.ScreenUpdating = False For x = 1 To Range("B" & .Rows.Count).End(xlUp).Row For i = 1 To Len(Cells(x, 2)) If Mid(Cells(x, 2), i, 1) = ":" Then Cells(x, 1) = Mid(Cells(x, 2), 1, i - 1) & " :" Cells(x, 2) = Mid(Cells(x, 2), i + 1, Len(Cells(x, 2)) - 1) & "." GoTo 1 End If Next i 1 Next x Application.ScreenUpdating = True End Sub السلام عليكم اضافة لما ادلى به اخي سليم و اخي ياسر اعتقد ان هذا الكود ايضا يفي بالغرض

مرحبا في الحدث : Private Sub UserForm_Initialize() أكتب تحت هذا السطر : Sheets("Sheet1").Activate السطرين التاليين '-------------------------------------------------------------------- LRoww = Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Row If LRoww = 2 Then Exit Sub '--------------------------------------------------------------------