الـعيدروس

===================================== شيت الهاربين توقفت الخدمة فيه تمام موش بيشتغل خالص ليه عاوزه زى ماكان بجميع حقوله ماكنش عندى تعليق عليه " إقتباس" ============================== اخي الفاضل حصل من قبلك اضافة سطور جديده من اعلى في هذا الشيت عشان كذا توقف عمل الكود بسبب إضافة السطور

اعذرني اخي شغل العجله بيعمل كذا العذر منك والسموحه تفضل واي ملاحظات انا موجود مهم جد7.rar

تم التعديل حسب الشرح في التعليقات جرب المرفق مهم جدا6.rar

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

السلام عليكم جرب كذا واخبرني بالنتيجة مهم جدا3.rar

اطلع على المرفق هل هكذا تريد مهم جدا2.rar

اخي الفاضل ان شغال عليه الحين دقايق وارفقه طول بالك علينا

هل هذا ماتقصده مهم جدا1.rar

ضي النور ارجو ارفاق الكود كي يتم توضيح الخطاء

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

برضه عندي لم يعمل تخفت الشاشه فقط ولابظهر اي شيء

السلام عليكم الاخ الفاضل mariammohamed الذي افتهم لي من طلبك هو تريد جلب عدد معين من الطلبه كل فصل في جدوله في ورقة 22 مثال تريد اول 20 تلميذ من فصل 1/2 في جدول 1/2 الذي في ورقة 22 وتريد 15 تلميذ من فصل 2/2 في جدول 2/2 الذي في ورقة 22 وطلبك العدد الذي في ورقة 2 وانا عملته في ورقة 22 فوق جدول 2/1 وجدول 2/2 تلاقي خلايا ملونه بلون احمر اكتب عليها عدد الطلبه المراد اظهارهم في الجدول واضغط على الزر لكل جدول زر مخصص يعني هذا كود وهذا كود اخر واذا لم يكن الطلب فأرجو توضيح الطلب بشرح على الملف نفسه تحياتي حسب العدد.rar

السلام عليكم فرضاً أن أسم الورقة التي فيها زر الكود اي الاسم الاساسي وليس المستعار (sheet1) وأن باسورد الحماية (123) هذا السطر في أول الكود وعمله الغاء الحماية عند تنفيذ الكود sheet1.Unprotect ("123") اذا تريد استخدام اسم الورقة المستعار إستخدم الاسلوب التالي فرضاً ان اسم الورقة (بيانات) sheets("بيانات").Unprotect ("123") وهذا السطر في نهاية الكود قبل End Sub عملة إسترجاع كلمة المرور للحماية بعد تنفيذ الكود sheet1.Protect PASSWORD:="123" أو بإسم الشيت المستعار sheets("بيانات").Protect PASSWORD:="123" أرجو أن تكون أتضحت الفكرة والسلام عليكم

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

السلام عليكم جزاك الله خير استاذ ابو اسامة العينبوسي هكذا الاكواد ولا فلا تقبل مروري

الرسالة تنبيه فقط الحمد لله انه زبط معك تحياتي

السلام عليكم استاذ احمد زمان نتائج صحيحة 100 % جزاك الله كل خير وجعل هذا العمل في ميازين حسناتك تقبل مروري

غير في هذا الجزء من الكود RGB(220, 90, 0 حط مثلا بدل الــ 90 50 ليصير هكذا RGB(220, 50, 0

السلام عليكم الاخ الفاضل leprince2007 هذا الكود يقوم بنسخ من مسار تحددة في الكود وملف الاكسل والورقة من الملف تحددها والمدى يقوم بالنسخ والملف مغلق ولاكن ؟؟؟؟؟؟؟؟؟؟؟ ؟؟؟؟؟؟؟؟ لملف واحد فقط Private Function GetValue(path, file, sheet, ref) Dim arg As String If Right(path, 1) <> "\" Then path = path & "\" If Dir(path & file) = "" Then GetValue = "File Not Found" Exit Function End If arg = "'" & path & "[" & file & "]" & sheet & "'!" & _ Range(ref).Range("A1").Address(, , xlR1C1) GetValue = ExecuteExcel4Macro(arg) End Function Sub TestGetValue2() '==================================== p = "C:\temp" ' المسار احد الاقراص فقط دون ملف الاكسل '==================================== f = "ALI2011.xls" ' إسم ملف الإكسل فقط '==================================== s = "ورقة1" ' إسم الورقة المراد نسخ احد البيانات منها '==================================== Application.ScreenUpdating = False '==================================== For r = 1 To 100 ' هنا حلقة التكرار تعبر عن الصفوف من صف رقم واحد حتى صف رقم 100 '==================================== For c = 1 To 12 ' هنا حلقة التكرار تعبر عن الاعمدة من عمود رقم 1 حتى عمود رقم 12 '==================================== ' ======================= ' المدى ككل من A1:L100 '======================== a = Cells(r, c).Address Cells(r, c) = GetValue(p, f, s, a) Next c Next r Application.ScreenUpdating = True End Sub هذا الكود سبق ان ذكرة الاستاذ القدير والمعلم الكبير محمد طاهر تحياتي

السلام عليكم الاخ الفاضل skyblue بالنسبة الترحيل الى ورقة 1 ماعمره هيكون فاضل لان طلبك المرة اللي فاتت الاحتفاظ برصيد اول المدة لتكست 2 وتكست 2 يقراء رصيد اول المدة من ورقة 1 فا أرجو شرح المطلوب لماذا الشرط واذا كان الشرط لشيئ اخر فالكود بيكون كذا بعد اضافة الشرط Private Sub CommandButton3_Click() If ورقة1.Cells(1, 13).Value > "" Then MsgBox "سبق ترحيل الرصيد", vbExclamation, "خلايا ممتلئه": Exit Sub 'مسح القيم القديمة ورقة2.Cells(5, 5).Value = "" ورقة2.Cells(5, 6).Value = "" ' إدراج القيم الجديدة ورقة2.Cells(5, 5).Value = TextBox25.Value ورقة2.Cells(5, 6).Value = TextBox26.Value TextBox26 = TextBox25.Text ورقة1.Cells(1, 13).Value = TextBox26.Value TextBox25.Value = "" End Sub واذا كنت تقصد الضرط على تكست رصيد اول المدة بيكون هكذا Private Sub CommandButton3_Click() If TextBox25.Value = "" Then MsgBox "سبق ترحيل الرصيد", vbExclamation, "خلايا ممتلئه": Exit Sub 'مسح القيم القديمة ورقة2.Cells(5, 5).Value = "" ورقة2.Cells(5, 6).Value = "" ' إدراج القيم الجديدة ورقة2.Cells(5, 5).Value = TextBox25.Value ورقة2.Cells(5, 6).Value = TextBox26.Value TextBox26 = TextBox25.Text ورقة1.Cells(1, 13).Value = TextBox26.Value TextBox25.Value = "" End Sub واضنه هذا طلبك والسلام عليكم

السلام عليكم ملفك الاخر معطوب او activewinedow مغلق عنه هذا الكود حطه في حدث ThisWorkbook Private Sub Workbook_Open() Call ali_PATH End Sub وهذا الكود في مدويل Public Sub ali_PATH() On Error Resume Next Dim sPfad As String, retVal As Byte, se_FEL As String, wb As Workbook sPfad = ThisWorkbook.Path & "\" & "Vehicles data.xls" retVal = DateNichtDa(sPfad) If retVal Then MsgBox " غير موجود الملف" Exit Sub Else MsgBox IIf(retVal = 1, "تم الفتح") se_FEL = ThisWorkbook.Path & "\" & "Vehicles data.xls" Set wb = Workbooks.Open(se_FEL, True, True) End If End Sub وهذا كود Function للتحقق من وجود الملف في الفولدر Private Function DateNichtDa(DerPfad As String) As Byte On Error GoTo PfadError DateNichtDa = IIf(Len(Dir(DerPfad)) > 1, 0, 1) Exit Function PfadError: DateNichtDa = 2 End Function وهذا الملف وفيه الاكواد moving1.rar

السلام عليكم اولا اشكر القائمين على هذه الدورة المميزة على رأسهم عبدالله المجرب اخي سعد عابد بالنسبة للماكرو وكتابتة عني انا شخصيا بدأت بتتبع الأكواد بمعنى مجرد ماانفذ كود من اي موضوع اقوم بقرأته ومادور كل سطر منه وبعض اكواد اقعد ادور على دالة استخدمت فيه يمكن ياخذ مني اسبوع هذا الكلام كصفه عامة واما مابدأت بتعلمه بصفه خاصة استخدام Range و Cells و For next ومايليها من أدوات التكرار والطريقة الاولى هيا تسجيل ماكرو والتعديل عليه هذه بالاخص سوف تفيدك كثير هذا مابجعبتي والسلام عليكم

السلام عليكم حلك جميل برضه ونفس الطريقة ولاكن بعدت مودويل وبالنسبة لطلبك الاخير سهل اخي في اول الشرط If Range("a3").Value = 2 Then تحط ماطلبته في مشاركتك في جواب الشرط هذا السطر Range("d18:d114").ClearContents لمسح بيانات عمود الـــ D فقط وفي عدم توافق الشرط بعد الكلمة التاليه Else تحد هذا المدى وهو من D حتى H Range("d18:h114").ClearContents الكود بعد التعديل بيكون هكذا Sub Abu_Ahmed() If Range("a3").Value = 2 Then Range("d18:d114").ClearContents For I = 5 To 12 For x = 1 To Cells(10, I).Value Cells(Range("d10000").End(xlUp).Row + 1, 4) = Cells(9, I) Next Next Else Range("d18:h114").ClearContents For i1 = 5 To 12 For x1 = 1 To Cells(11, i1).Value Cells(Range("f10000").End(xlUp).Row + 1, 6) = Cells(9, i1) Next Next For i2 = 5 To 12 For x2 = 1 To Cells(12, i2).Value Cells(Range("h10000").End(xlUp).Row + 1, 8) = Cells(9, i2) Next Next For i3 = 5 To 12 For x3 = 1 To Cells(10, i3).Value Cells(Range("d10000").End(xlUp).Row + 1, 4) = Cells(9, i3) Next Next Exit Sub End If ارجو ان تكون وضحت الصورة لديك تحياتي

السلام عليكم جرب هكذا Sub Abu_Ahmed() Range("d18:h114").ClearContents If Range("a3").Value = 2 Then For I = 5 To 12 For x = 1 To Cells(10, I).Value Cells(Range("d10000").End(xlUp).Row + 1, 4) = Cells(9, I) Next Next Else For i1 = 5 To 12 For x1 = 1 To Cells(11, i1).Value Cells(Range("f10000").End(xlUp).Row + 1, 6) = Cells(9, i1) Next Next For i2 = 5 To 12 For x2 = 1 To Cells(12, i2).Value Cells(Range("h10000").End(xlUp).Row + 1, 8) = Cells(9, i2) Next Next For i3 = 5 To 12 For x3 = 1 To Cells(10, i3).Value Cells(Range("d10000").End(xlUp).Row + 1, 4) = Cells(9, i3) Next Next Exit Sub End If End Sub وهذا ملفك وعليه الكود اعلاه من إحصائية شهرية_ali.rar

السلام عليكم الاخ الفاضل addora2006 عذرا على التأخير لم انتبه على ردك بيكون الكود هكذا Sub Abu_Ahmed() Range("d18:d114").ClearContents For I = 5 To 12 For x = 1 To Cells(10, I).Value Cells(Range("d10000").End(xlUp).Row + 1, 4) = Cells(9, I) Next x Next I End Sub ========================================================== - في حالة ترك خانة فارغة " مثلا : الصف الثالث غير موجود " , يحدث خلل في التوزيع ولا تكمل العملية "إقتباس" ========================================== الكود لايحسب الخلايا الفارغه ويستخدم التي بعدها بمعنى لايحدث خلل ربما اكون فهمت قصدك خطاء هل تعني احد عدد (السنه الاولى ثانوي) تركته فارغ وسبب اختلال في التوزيع اذا كان هذا معنى كلامك فأطمن جربت الكود ووزع تمام على ملفك