نجوم المشاركات

السلام عليكم اذا كان هناك تعليق على الخلية سيقوم باضافة قائمة وسيقوم باستخدام الاسم الموجود في التعليق لنطاق القائمة شاهد المرفق 2003 FrameScrollBars1.rar

الأخ الشهابي يمكن استخدام Value بدلاً من Text أيضاً Sub openfile() Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & Range("a1").Value & ".xlsm" End Sub

اخى الفاضل تفضل المرفق لربما به طلبك ... تحياتي TR.rar

تفضل اخي مبيعات.rar

السلام عليكم ورحمة الله وبركاته كيف حالكم إخواني الكرام في المنتدى الأغر ... هل ....؟ سؤال موجه لكم وليس لي هل .....؟ والإجابة على السؤال بهل إما بـ "نعم" أو بـ "لا" هل قمت يوماً ما بتحميل مصحف كامل لأحد القراء المحببين إليك؟ إذا كانت الإجابة بنعم انتقل للسؤال الثاني وإذا كانت الإجابة بـ "لا" .. مش عيب عليك تحمل أفلام ومسلسلات وألعاب وناسي كتاب الله السؤال الثاني : هل بعد عملية التحميل وجدت أن المجلد الذي يحتوي على السور مرقمة من 001 و 002 إلى 114 بدون أسماء السور؟ إذا كانت الإجابة بـ "نعم" فإليك الحل السحري مع الإكسل .. الحل هو دمج أسماء السور مع الاحتفاظ بالرقم أيضاً من أجل ترتيب السور ، لتصبح في النهاية بهذا الشكل 001 - الفاتحة ، 002 - البقرة وهكذا!! خطوات العمل : ************** قم بنسخ المصنف الذي سأقوم بإرفاقه في نفس مسار المجلد الذي يحتوي على السور القرآنية .. افتح المصنف .. اضغط زر الأمر .. وشكراً لكم على حسن تعاونكم معنا أترككم مع الملف :fff: Rename Quran Files.rar

أخي الحبيب ومعلمنا الكبير عبد الله باقشير ما أروعك ما أبدعك ما أجملك ما أخف ظلك ما أحلاك نقف جميعاً أمام إبداعاتك صااااااااااااااااااااااااااااااااامتين ..تأخذنا الدهشة والروعة !! جزيت عنا خير الجزاء في الدنيا والآخرة ، وجمع الله بيننا في الفردوس الأعلى اللهم آمين

شرح بالصور لطريقة تصميم ماكرو التشغيل التلقائي الذي يعمل عند فتح قاعدة البيانات وبالتوفيق للجميع ماكرو التشغيل التلقائي.rar

تفضل مطلوبك db.rar

Private Sub Form_Open(Cancel As Integer) If CurrentProject.Name = "myName.mdb" Then Else DoCmd.Quit End If End Sub

تفضل تم التعديل حسب رغبتك جعلنا هذا المعيار في حقل التاريخ داخل الاستعلام >Year(Date())-10 الرقم 10 يعني السنوات التي سيتم عرضها تنازليا قاعدة البيانات11.rar

لحفظ ملف باسم خلية في المسار c:\ExcelFiles جرب حفظ باسم خلية.rar

إليك أخى المطلوب وفقا لأوفيس 2003 وأوفيس 2007 تقبل تحياتى نقل البيانات بدون تكرار ومرتبة أبجديا OFFICE 2003.rar نقل البيانات بدون تكرار ومرتبة أبجديا OFFICE 2007.rar

اذهب الى هذا العنوان http://www.officena.net/ib/index.php?showtopic=58824

أخى الفاضل وبعد إذن أستاذي القدير أ.ياسر .. اجعل الكود هكذا بزيادة جملة واحدة فقط Sub CopyRows() 'تعريف المتغيرات Dim LR As Long, I As Long, X As Long '[D]تحديد آخر صف به بيانات بالعمود LR = Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row 'متغير يحمل القيمة 5 كبداية للصفوف المراد نسخ الصفوف إليها ، أي أن الرقم 5 هو صف البداية للنتائج X = 5 'إلغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'مسح الصفوف في ورقة النتائج بداية من الصف الخامس إلى الصف الألف Sheets("Sheet2").Rows("5:1000").ClearContents 'وحتى آخر خلية بها بيانات لعمل شرط على قيمة الخلية[Sheet1]حلقة تكرارية بداية من الصف الرابع في ورقة العمل For I = 4 To LR 'إذا كانت قيمة الخلية في العمود الرابع تساوي واحد 'يقوم هذا السطر في حالة تحقق الشرط بنسخ الصف إلى ورقة النتائج في الصف الخامس كبداية 'بمقدار 1 استعداداً لنسخ صف جديد في حالة تحقق الشرط[X]ثم بعد عملية النسخ واللصق يتم زيادة المتغير If Cells(I, "D").Value = 1 OR Cells(I, "F").Value = 1 Then Rows(I).Copy Sheets("Sheet2").Range("A" & X): X = X + 1 'الانتقال لصف جديد لعمل اللازم Next I 'إلغاء خاصية النسخ واللصق Application.CutCopyMode = False 'تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True End Sub تحياتي

بارك الله فيك اخي العزيز عبد الرحمن هاشم و جزاك خير الجزاء اود اضافة حل آخر بإستخدام خاصية RecordCount لمجموعة السجلات مرفق الملف بعد التعديل بالتوفيق للجميع USER.rar

تفضل أخي الكريم شرح الكود Sub CopyRows() 'تعريف المتغيرات Dim LR As Long, I As Long, X As Long '[D]تحديد آخر صف به بيانات بالعمود LR = Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row 'متغير يحمل القيمة 5 كبداية للصفوف المراد نسخ الصفوف إليها ، أي أن الرقم 5 هو صف البداية للنتائج X = 5 'إلغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'مسح الصفوف في ورقة النتائج بداية من الصف الخامس إلى الصف الألف Sheets("Sheet2").Rows("5:1000").ClearContents 'وحتى آخر خلية بها بيانات لعمل شرط على قيمة الخلية[Sheet1]حلقة تكرارية بداية من الصف الرابع في ورقة العمل For I = 4 To LR 'إذا كانت قيمة الخلية في العمود الرابع تساوي واحد 'يقوم هذا السطر في حالة تحقق الشرط بنسخ الصف إلى ورقة النتائج في الصف الخامس كبداية 'بمقدار 1 استعداداً لنسخ صف جديد في حالة تحقق الشرط[X]ثم بعد عملية النسخ واللصق يتم زيادة المتغير If Cells(I, "D").Value = 1 Then Rows(I).Copy Sheets("Sheet2").Range("A" & X): X = X + 1 'الانتقال لصف جديد لعمل اللازم Next I 'إلغاء خاصية النسخ واللصق Application.CutCopyMode = False 'تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True End Sub لا تنسانا بدعوة بظهر الغيب

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

اخى اليك الكود المستخدم Private Sub Workbook_Open() Sheet1.Select End Sub تقبل تحياتى Book1.rar

السلام عليكم ورحمة الله وبركاته معلش لى سؤال صغيرفى تنسيق الشيت اللى حضرتك عمله عنما اقف على خلية معينة يتم تلوين باقى خلايا الصف كيف يتم عملها وشكرا لك تقبل مرورى اخى سيف هذه محاوله منى ارجو ان تفى بالغرض اتبع الشرح الاتى =CELL("address")=ADDRESS(ROW(),COLUMN()) =OR(AND(CELL("row")=ROW())) تقبل تحياتى

الأخ المشاكس رفيع سعد من كان حليفا فليحلف بالله أو ليصمت (متقولش والنبي تاني وإلا مش هعبرك تاني ههههه) .. أتعبتني ..وولكن ولا يهمك المهم تدعي للكبير ابن مصر ولا تنساني أنا الآخر بدعوة بظهر الغيب Sub TransferProducts() 'تعريف المتغيرات Dim ws, ws2 As Worksheet Dim lr, lr2 As Long '[Data]لورقة العمل التي باسم[ws]تعيين المتغير Set ws = ThisWorkbook.Sheets("Data") '[All]لورقة العمل التي باسم[ws2]تعيين المتغير Set ws2 = ThisWorkbook.Sheets("All") '[ws]في ورقة العمل[K]تعيين رقم آخر صف به بيانات في العمود lr = ws.Cells(Rows.Count, 11).End(xlUp).Row '[ws2]تعيين رقم أول صف فارغ في العمود الرابع في ورقة العمل lr2 = ws2.Cells(Rows.Count, 4).End(xlUp).Row + 1 'إيقاف خاصية إهتزاز الشاشة Application.ScreenUpdating = False 'إظهار رسالة تفيد بتأكيد الترحيل من عدمه ، فإذا تم الضغط على زر الأمر لا يتم الخروج من الإجراء الفرعي If MsgBox(" هل تريد بالتأكيد ترحيل البيانات ومسحها" & vbCr & vbCr & String$(40, "="), vbCritical + vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading + vbDefaultButton2, "تاكيد الترحيل ") = vbNo Then Exit Sub '[H3:J3]يتم نسخ بيانات الزبون الموجودة في النطاق ws.Range("H3:J3").Copy '[ws2]بعد عملية النسخ يتم لصق البيانات في العمود الأول في ورقة العمل ws2.Range("A" & lr2).PasteSpecial (xlPasteValues) 'يتم نسخ النتائج التي تم استخراجها من الكود السابق ws.Range("K3:M" & lr).Copy 'يتم لصق البيانات ولكن بشكل أفقي وليس عمودي في بداية العمود الرابع ws2.Range("D" & lr2).PasteSpecial (xlPasteValues), , , True 'إلغاء خاصية النسخ واللصق Application.CutCopyMode = False '[ws]مسح النطاق الذي يحتوي على النتائج حتى آخر خلية بها بيانات في ورقة العمل ws.Range("K3:M" & lr).ClearContents '[clear]استدعاء الإجراء الفرعي المسمى Call clear 'إعادة تفعيل خاصية إهتزاز الشاشة Application.ScreenUpdating = True End Sub Sub clear() 'تعريف المتغيرات Dim ws As Worksheet Dim lr, lr2, lr3 As Long Dim i, y As Integer '[Data]لورقة العمل التي باسم[ws]تعيين المتغير Set ws = ThisWorkbook.Sheets("Data") '[ws]تعيين رقم آخر صف به بيانات في العمود الأول في ورقة العمل lr = ws.Cells(Rows.Count, 1).End(xlUp).Row '[ws]بدء التعامل مع ورقة العمل With ws 'حلقة تكرارية للأعمدة من العمود الثاني إلى العمود الخامس For y = 2 To 5 'حلقة تكرارية من الصف الثالث وحتى آخر صف به بيانات For i = 3 To lr Step 6 'يتم مسح الخلاياالتي بها الكميات .Cells(i + 1, y).Value = "" Next i Next y End With End Sub

أخى الحبيب الدالة المعرفة ليست من ضمن دوال الأوفيس ، ولكنها عبارة عن كود برمجى بتم وضعة داخل ( module ) يتم الوصول له عن طريق الضغط على " alt+f11 " تقبل تحياتى

السلام عليكم قلت قبل ما أنا أقدم لكم دالة كدا ع السريع يمكن تفيد أي حد الدالة تقوم بعمل عد للتواريخ في نطاق ما .. الدالة بسيطة جدا بتعتمد على اختبار الخلية باستخدام IsDate وترجع القيمة إلى True أو False فلما يكون تاريخ العداد يضيف واحد في كل مرة أرجو أن تنال إعجابكم Function CountDates(R As Range) For Each Cell In R If IsDate(Cell) Then Counter = Counter + 1 Next Cell CountDates = Counter End Function

السلام عليكم ورحمة الله وبركاته اقدم هذا العمل واهديه الى اساتذتى وكل أعضاء اوفيسنا وهو: بعيد عن المعادلات والاكواد . استخدام الصور في المخططات والرسومات البيانية اسال الله ان يتقبل منى هذا العمل ملحوظه ذكرت أسماء أساتذتي في المنتدى ووضعت بيانات افتراضيه فقط تقبلوا خالص تحياتي تلميذ اوفيسنا استخدام الصور فى الرسم البيانى.rar

UP

السلام عليكم الاخ الكريم / ayman_2000 مرورك روعة وحضورك هنا اجمل بارك الله فيك وجزاك الله خيرا

كل ما كان الكود مختصرا كلما امكن السيطرة عليه وادراج الحقول واحدا واحدا غير مقبول ويتأكد عدم قبوله عندما تكون الحقول كثيرة هاك طريقة مختصرة يتم النسخ فيها بالجملة للنموذج الرئيسي ويتم الاستعانة بجدول مؤقت كحلقة وصل بين النسخ واللصق Contract4.rar

السلام عليكم أخي أيسم حياك الله هذا الملف حملته من المنتدى لا أدري صاحبه ربما يفيدك ____________.rar