طارق محمود

السلام عليكم تفضل اخي الكريم المرفق ترحيل بيانات اليوم وبدأ يوم جديد.rar

السلام عليكم أخي العزيز هذا الكود للمحولين إلي المدرسة Sub ToSchool() ' ' Macro1 Macro ' Lst_R = [B1000].End(xlUp).Row For r = 12 To Lst_R cls = Cells(r, 3) For w = 1 To Worksheets.Count a = Format(cls, "0") If Sheets(w).Name = a Then Range("B" & r & ":R" & r).Copy new_R = Sheets(a).[B1000].End(xlUp).Row + 1 Sheets(a).Range("B" & new_R).PasteSpecial Paste:=xlPasteValues Sheets(a).Range("A" & new_R).Value = Sheets(a).Range("A" & new_R - 1).Value + 1 Range("A" & r & ":R" & r).ClearContents Application.CutCopyMode = False GoTo 10 End If Next w ' No sheets named this Class MsgBox ("No Class =" & cls) Exit Sub 10 ' exit FOR w Next r End Sub وهذا للمحولين من المدرسة Sub FromSchool() ' ' Macro1 Macro ' Lst_R = [B1000].End(xlUp).Row For r = 12 To Lst_R cls = Cells(r, 3) kid = Cells(r, 2) For w = 1 To Worksheets.Count a = Format(cls, "0") If Sheets(w).Name = a Then ' Range("B" & r & ":R" & r).Copy new_R = Sheets(a).[B1000].End(xlUp).Row For i = 11 To new_R kkid = Sheets(a).Cells(i, 2) If kkid = kid Then GoTo 15 Next i ' Not found the KID's name in this Class MsgBox ("No KID's named " & Chr(10) & kid & Chr(10) & "in Class " & a) Exit Sub 15 ' found the KID - exit FOR i (keep the Row number of Kid in i) Sheets(a).Range("B" & i + 1 & ":R" & new_R + 1).Copy Sheets(a).Range("B" & i).PasteSpecial Paste:=xlPasteValues Sheets(a).Range("A" & new_R).ClearContents Range("A" & r & ":R" & r).ClearContents GoTo 10 End If Next w ' No sheets named this Class MsgBox ("No Class =" & a) Exit Sub 10 ' exit FOR w Application.CutCopyMode = False Next r End Sub وتفضل المرفق أيضا المحولين.rar

السلام عليكم أخي يوسف الكود كالتالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column > 52 Then Exit Sub rr = Target.Row cc = Target.Column VBA.Calendar = vbCalHijri Cells(rr, cc + 52) = Date & " _ " & Time End Sub وإذا لاترغب بالتاريخ الهجري إحذف السطر VBA.Calendar = vbCalHijri

السلام عليكم أخي الكريم اتبع الخطوات التالية أولا خذ نسخة من الكود من مشاركتي السابقة ثم إضغط ALT-F11 لتشغيل محرر الفيجوال بيزيك علي اليسار ستلاحظ وجود اسم الملف وتحته أسماء الشيتات قف علي الشيت المطلوب (دبل كليك) والصق النسخ في الشاشة التي باليمين أنظر المرفق به صورة وبه الكود شغال ملحوظة لكي يعمل الكود جيدا لابد من تقليل أمان الماكرو إن أردت تسجيله علي إكسل 2007 أو 2010 فيتم ذلك باختيار امتداد الملف xlsm وليس xlsx لذلك سجلته لك بتنسيق 2003 تفضل المرفق وأرجو ألا تتردد في أي سؤال جمع الأرقام.rar

السلام عليكم لم أستطع تحميل الملف من الرابط الذي أعطيته انا عملت لك ملف بنفس المواصفات علي الرابط التالي http://www.4shared.com/file/wixJxYVC/_____.html تفضل

السلام عليكم أخي العزيز / أبا ملك انسخ الكود التالي في حدث الورقة Sheet1 Private Sub Worksheet_SelectionChange(ByVal Target As Range) [AB1] = [B4] End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$B$3" Then Exit Sub x = [AB1] [B4].FormulaR1C1 = "=R[-1]C+" & x End Sub

السلام عليكم أهلا ومرحبا بك أخي الكريم سليم يمكنك رفع الملفات المضغوطة فقط ، بعد ضغط الملف الإكسل بواسطة winrar أو winzip

السلام عليكم أخي العزيز غير المعادلة في الورقة تقرير فتري : الخلية B4 لتكون =SUMPRODUCT((INDIRECT("'"&H4&"'!A$6:A$26")>=$C$3)*(INDIRECT("'"&H4&"'!A$6:A$26")<=$B$3)*(INDIRECT("'"&H4&"'!E$6:E$26"))) لاحظ أنني جعلت مجال الدالة إلي نهاية البيانات فقط ثم غير المعادلة في الورقة 1 الخلية F6 لتكون =IF(AND(E6=""),0,IF(E6>19,E6*5,E6*10)) أي ضع صفر مكان الـ "" وكذلك الخلية F26 في نفس الورقة وكرر ذلك مع كل الورقات

السلام عليكم أولا: أهلا ومرحبا بك بين إخوانك ثانيا: السؤال غير واضح هل تقصد ان الناتج مثل الحالات التالية؟ اذا كان الإضافي من 0 إلي 29 دقيقة لايحتسب شيء واذا كان الإضافي من 30 إلي 59 دقيقة يحتسب فقط نصف ساعة واذا كان الإضافي من 1:00 إلي 1:29ساعة يحتسب فقط ساعة واحدة واذا كان الإضافي من 1:30 إلي 1:59ساعة يحتسب فقط ساعة ونصف وهل تريد بعد ذلك ضرب هذا الناتج في 1.5 أم لا؟

السلام عليكم إخواني الأعزاء: عبد الله المجرب - كيماس - ياسر الحافظ.... وكل من تكرم بالمرور شاكرا جدا لمروركم وكلماتكم الرقيقة

السلام عليكم أخي الكريم أضف سطر النتيجة الهجرية للكود ليكون كالتالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 1 Then Exit Sub rr = Target.Row VBA.Calendar = vbCalHijri Range("B" & rr) = Date & " _ " & Time End Sub

السلام عليكم أخي المعتصم جزاك الله خيرا لم اكن اعلم هذا من قبل اللهم علمنا ماينفعنا وانفعنا بما علمتنا وزدنا علما آمين أنا وسائر الأعضاء بالمنتدي وسائر إخواننا المسلمين آمين آمين

السلام عليكم في الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 1 Then Exit Sub rr = Target.Row Range("B" & rr) = Date & " _ " & Time End Sub كل تغير في أي خلية من العمود A يتبعه مباشرة تسجيل وقت التغيير في الخلية المقابلة لها في العمود B فقط يرجي تزويد عرض العمود B يدويا ليتسع للوقت والتاريخ

السلام عليكم أخي الكريم أنظر المرفق علي الرابط http://www.4shared.com/file/TRrXvwhC/2_online.html

السلام عليكم أختي الفاضلة تفضلي هذا الكود Sub Shift() Range([A4], ActiveCell.SpecialCells(xlLastCell)).Copy Sheets("11").[A1000].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False MsgBox ("Shift data >> Done .... Successful") End Sub للأسف ، لاأستطيع رفع من هذا الجهاز للمنتدي وإلا كنت رفعت لك الملف

السلام عليكم أخي العزيز هذا لايكون بدالة من دوال الإكسل الجاهزة ولكن يمكن تفصيل دالة بالأكواد لهذا الغرض فهل هذا هو ماتريد؟

السلام عليكم أخي الحبيب / المعتصم جزاك الله خيرا للعلم ، أيضا ، يمكن إستخدام الرمز ^ للدلالة علي الأس زر شيفت مع الرقم 6 العلوي أي الذي مع الحروف وليس الذي في يمين لوحة المفاتيح مع الأرقام =100^0.5 =100^(1/2)

السلام عليكم تفضل المرفق به الكود جرب تقفل علي أي شييت غير الثاني عند الفتح سيفتح الشيت الثاني دائما وكذلك معادلة إحضار المادة الحراسة تجريبي_2.rar

السلام عليكم أخي الكريم إبحث أولا علي الجهاز عندك من كنتول بانل - طابعة/ فاكس قد تجد إحدي الطابعات لديك PDF فيكون أنك تطبع مستنداتك علي هذه الطابعة الوهمية التي تحول المستند إلي تلك الصيغة وإلا تلجأ للتالي إما أن يكون الأكروبات عندك نسخة كاملة أو بروفيشنال فكل ماعليك أن تختار من الأوبشنز تفعيل طابعة الـ PDF وإما أن يكون لديك برنامج للتحويل وهي برامج كثيرة علي النت ومجانية إبحث مثلا عن Cutewriter بعد تحميله وتنصيبه ، ستجد ان الطابعات لديك زادت واحدة وهمية اسمها Cutewriter وهي التي ستحول المستند إلي تلك الصيغة

السلام عليكم أخي الكريم حاول التفعيل ثانية مع جعل الحماية أقل مايمكن أنظر الصورة

السلام عليكم أخي الكريم المطلوب الأول : أين هي المادة في الورقة 2 لكي أجلبها لك بمعادلة أعذرني حيث أنني لست مدرسا ولست خبيرا في هذا فقط دلني عليها وأأتي لك بها إن شاء الله المطلوب الثاني إذا كنت تقصد بالصفحة الرئيسية الورقة الثانية فتضع هذا الكود في حدث الملف Private Sub Workbook_Open() Sheets(2).Activate End Sub

السلام عليكم أختي الفاضلة المرفق الذي أرفقته لك منذ 5 أيام به كل ذلك أو أنني لا افهم ماذا تريدين بالضبط أنظري للصفحة الأخيرة قاعدة بيانات ستجدي بها الصنف ، ورقم تسلسله أما بيانات العميل فهي موجودة بالورقة Customer ويكفينا أننا رحلنا رقم العضوية ومنه باقي البيانات تأتي بدالة الــ VLOOKUP وهذه بعد عمل التصفية Filter يكون الشكل الناتج مرتبا أرجو المراجعة مرة أخري وتحديد دقيق أو مثال لشكل الناتج الذي تريدين

السلام عليكم إخواني الأعزاء توفي والد أخونا زياد في سبتمبر (أيلول) الماضي ، أي منذ 9 شهور وبإذن الله هو ممن تشملهم رحمه الله وممن يسكنون الجنان وكان المفروض ان يغلق الموضوع بعد المشاركة #35 لأخونا الفاضل هادى محمد المامون سالم في 08/10/2010 ولكن لم يغلق وقد رآه بالأمس الأخ / saiedbiram وعلق عليه بالمواساة طبعا المشاركة #36 ومن بعدها إنهالت التعازي مرة أخري لابأس ولكن لاعزاء بعد ثلاث لأن هذا يؤلم أخونا زياد ويعيد الأحزان أنا لم أكلمه ولكنني متأكد أنه يعلم مدي غلاوته عندي فإبني الأكبر اسمه زياد وكلنا في المنتدي آباء وأخوة للغالي زياد فأرجو توقف التعازي وليغلق أحد مشرفينا الأفاضل الموضوع علي هذا أخوكم طارق محمود (أبو زياد)

السلام عليكم اخي العزيز ممكن باستخدام دالة IF اذا كنت تعني بـ رمز symbol

إستخدم الدالة مرتين COUNTIF مرة تحسب إجمالي الأكبر من أويساوي 30 ثم تطرح منه الأكبر من 50 أي أن من يساوي 50 مثل الطالب الأول أحمد سيدخل في العدد كالتالي =COUNTIF(B2:B13,">=30")-COUNTIF(B2:B13,">50")