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

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله لطالما أردت طرح هذا الموضوع الهام جداً والشيق جداً والمفيد جداً .. ولكن يبدو أن الزهايمر يلعب دوراً هاماً في حياتي .. عموماً ذكرني عنوان موضوع رأيته الآن بهذا الموضوع ، فأحببت أن أشارككم هذا الكود الرائع والمتميز .. الكود يقوم بالمهام التالية .. في بداية تنفيذ الكود يمكنك الكود من اختيار الطابعة المطلوب الطباعة عليها .. من خلال الصور سأقوم بالطباعة على ملف بامتداد XPS .. حتى لا أهدر أوراقي (سامحوني .. دا مش بخل دا حرص مش كدا ولا ايه يا فلاحجي (لأنه أكتر واحد هيفهمني )) حسناً رأيتم الصورة معبرة ..أليست كذلك؟ نقرنا على زر الأمر PRINT ...فظهرت نافذة تتيح لنا إمكانية اختيار الطابعة ثم نضغط أوك لننتقل للنافذة التالية في النافذة التالية يتيح الكود كتابة عدد النسخ المراد طباعتها وبشكل افتراضي يكون عدد النسخ نسخة واحدة فقط ، ويمكن تغيير عدد النسخ المطلوبة هنا تظهر لك أوراق العمل الموجودة في المصنف عدا ورقة العمل النشطة المسماة Data ، يمكنك الكود من اختيار أوراق العمل المراد طباعتها بكل سهولة ثم أخيراً يتم تنفيذ أمر الطباعة ..في المثال الموضح سأقوم بتنفيذ أمر الطباعة لملف بامتداد XPS .. حيث يتم كتابة اسم الملف وتحديد المسار الذي سيحفظ فيه الملف ثم اوك قمت بتحديد مسار حفظ الملف بامتداد XPS على سطح المكتب وها هو الملف وقد طبع ورقتي العمل Sheet1 و Sheet3 فقط ، لأنني حددتهما من خلال النوافذ التي تظهر وأخيراً إليكم الكود الرائع الذي يقوم بكل هذه المهام الرائعة Sub PrintSelectedSheets() Dim I As Integer Dim TopPos As Integer Dim SheetCount As Integer Dim PrintDlg As DialogSheet Dim CurrentSheet As Worksheet Dim Cb As CheckBox Dim Numcop As Long Dim Cnt As Integer Dim X As String Application.Dialogs(xlDialogPrinterSetup).Show Application.ScreenUpdating = False If ActiveWorkbook.ProtectStructure Then MsgBox "المصنف محمي", vbCritical Exit Sub End If Set CurrentSheet = ActiveSheet X = CurrentSheet.Name Set PrintDlg = ActiveWorkbook.DialogSheets.Add SheetCount = 0 TopPos = 40 For I = 1 To ActiveWorkbook.Worksheets.Count Set CurrentSheet = ActiveWorkbook.Worksheets(I) If Application.CountA(CurrentSheet.Cells) <> 0 And CurrentSheet.Visible Then SheetCount = SheetCount + 1 PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5 PrintDlg.CheckBoxes(SheetCount).Text = CurrentSheet.Name TopPos = TopPos + 13 End If Next I PrintDlg.Buttons.Left = 240 With PrintDlg.DialogFrame .Height = Application.Max(68, PrintDlg.DialogFrame.Top + TopPos - 34) .Width = 230 .Caption = "اختر أوراق العمل المراد طباعتها" End With PrintDlg.Buttons("Button 2").BringToFront PrintDlg.Buttons("Button 3").BringToFront Numcop = Application.InputBox("أدخل عدد النسخ للطباعة:", "كم عدد النسخ?", 1, Type:=1) If Numcop = 0 Then ElseIf Len(Numcop) > 0 Then End If CurrentSheet.Activate Application.ScreenUpdating = True If SheetCount <> 0 Then If PrintDlg.Show Then For Each Cb In PrintDlg.CheckBoxes If Cb.Value = xlOn Then If Cnt = 0 Then Worksheets(Cb.Caption).Select Else Worksheets(Cb.Caption).Select Replace:=False End If Cnt = Cnt + 1 End If Next Cb ActiveWindow.SelectedSheets.PrintOut copies:=Numcop End If Else MsgBox "كل أوراق العمل فارغة", 64 End If Application.DisplayAlerts = False PrintDlg.Delete Sheets(X).Select End Sub تقبلوا جميعاً وافر تقديري واحترامي حمل الملف من هنا تحميلك للملف يدعم صاحب الموضوع .. فلا تبخل بدقيقة من وقتك .. وللعلم يمكنك عدم تحميل الملف ونسخ الكود في موديول في المصنف الخاص بك ، وستجد الكود جاهز للعمل لديك بدون تحميل الملف .. دمتم على طاعة الله ...

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله اطلعت منذ قليل على مشاركة لأخونا الغالي محمد حسن المحمد ، في موضوع خواطر إكسيلية ، وفي المشاركة أدرج معادلة رائعة تقوم بمعرفة السنة الكبيسة أو العادية من خلال عدد أيام شهر فبراير .. رابط المشاركة من هنا فتذكرت أن لدي ملف به أربعة عشر طريقة بالمعادلات لمعرفة السنة الكبيسة من السنة العادية في الملف المرفق : يتم وضع السنة في الخلية D4 بهذا الشكل مثلاً 2015 أو 2016 أو اكتب السنة التي تريد معرفة ما إذا كانت سنة كبيسة أم لا .. المعادلات موجودة في النطاق D7:D20 ، وتعطي النتيجة TRUE إذا كانت السنة كبيسة ، وتعطي القيمة FALSE إذا كانت السنة عادية وليست كبيسة .. قم بالذهاب إلى إدارة الأسماء Name Manager لتجد أن هناك نطاقات مسماة ، سوف تستخدم في المعادلات .. النطاق الأول المسمى Year يشير إلى الخلية D4 التي بها السنة المراد اختبارها ثم أربعة نطاقات لأربعة شهور ...الأول ليناير بهذا الشكل : اسم النطاق jan1st والمعادلة المرتبطة بهذا الاسم في إدارة الأسماء =DATE(year,1,1) حيث يشير إلى أول يوم في شهر يناير في السنة المحددة في الخلية D4 ... ونفس الكلام لثلاثة نطاقات للشهور feb1st و mar1st و april1st وآخر النطاقات المسماة هو febDays لحساب عدد أيام شهر فبراير للسنة المحددة في الخلية D4 =DATE(year,2,ROW('leap year check'!$A$1:INDEX('leap year check'!$A$1:$A$29,DAY(EOMONTH(feb1st,0))))) وأخيراً إليكم المعادلات المستخدمة لحساب ومعرفة ما إذا كانت السنة كبيسة أم غير كبيسة =DATE(year+1,1,1)-jan1st=366 =DATE(year,2,29)<>mar1st =DAY(EOMONTH(feb1st,0))=29 =WEEKDAY(feb1st)<>WEEKDAY(mar1st) =YEAR(jan1st)=YEAR(jan1st+365) =DATE(year,2,30)=mar1st =DAY(DATE(year,3,0))=29 =WEEKDAY(jan1st)=WEEKDAY(apr1st) =SUMPRODUCT(--(WEEKDAY(DATE(year,ROW($A$2:$A$12),1))=WEEKDAY(jan1st)))=2 =WEEKDAY(feb1st+1)<>WEEKDAY(EDATE(feb1st,12)) =SUMPRODUCT(--(WEEKDAY(febDays)=WEEKDAY(feb1st)))=5 =WEEKDAY(feb1st)=WEEKDAY(EOMONTH(feb1st,0)) =WEEKDAY(feb1st)=WEEKDAY(DATE(year,10,17)) =((MOD(year,4)=0)*((MOD(year,100)<>0)+(MOD(year,400)=0))=1) أرجو أن ينال الموضوع إعجابكم وأترككم مع الملف المرفق حمل الملف من هنا كان معكم أخوكم أبو البراء من منتدى أوفيسنا تقبلوا تحياتي

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

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

السلام عليكم ورحمة الله وبركاته جزاكم الله خيراً ..أخي الحبيب أبو البراء.. على هذه المعادلات الرائعة والكثيفة أمام دالة قدمتها لأستاذنا الكبير يحيى حسين ..جزاكم الله وإياه خيراً على ما تقدمونه. بارك الله...(من أعجبه شيء من أمر صاحبه فليبرّك ) ليقل بارك الله ..خير من خمسة وخميسة ..ودقوا على الخشب ..وعيني باردة ..فإنها بدع لا تمتّ بصلة إلى الدين . الحديث: حدثناه أبو العباس محمد بن يعقوب ، ثنا بحر بن نصر ، ثنا ابن وهب ، أخبرني يوسف بن طهمان ، عن محمد بن أبي أمامة بن سهل بن حنيف ، أنه سمع أباه يقول : اغتسل أبي سهل بن حنيف فنزع جبة كانت عليه يوم حنين حين هزم الله العدو ، وعامر بن ربيعة ينظر ، قال : وكان سهل رجلا أبيض حسن الخلق ، فقال له عامر بن ربيعة : ما رأيت كاليوم قط ، ونظر إليه فأعجبه حسنه حين طرح جبته ، فقال : ولا جارية في سترها بأحسن جسدا من جسد سهل بن حنيف ، فوعك سهل مكانه ، واشتد وعكه ، فأتى رسول الله صلى الله عليه وآله وسلم ، فأخبره أن سهل بن حنيف وعك ، وأنه غير رائح معك ، فأتاه رسول الله صلى الله عليه وآله وسلم ، فأخبروه بالذي كان من شأن عامر ، فقال رسول الله صلى الله عليه وآله وسلم : " علام يقتل أحدكم [ ص: 509 ] أخاه ، ألا بركت ، إن العين حق ، توضأ له " ، ثم قال رسول الله صلى الله عليه وآله وسلم : " إذا رأى أحدكم شيئا يعجبه فليبرك فإن العين حق " . " هذه الزيادات في الحديثين جميعا مما لم يخرجاه . والسلام عليكم ورحمة الله وبركاته

ربما يكون هذا ما تريد talween.rar

السلام عليكم ورحمة الله وبركاته... معلومة قرأتها وأحببت أن أتحفكم بها وهي: كيف نعرف السنة الميلادية ..كبيسة أو غير كبيسة "عادية".. =IF(DAY(EOMONTH(DATE(A1;2;1);0))=29;"سنة كبيسة";"سنة عادية") حيث نضع تاريخ السنة في الخلية A1 و المعادلة في B1 تتعلق المادلة بحساب شهر شباط 29 يوم كبيسة...28 يوم عادية تقبلوا تحياتي العطرة ...والسلام عليكم ورحمة الله وبركاته. للاطلاع على دوال أكثر ومعادلات تتعلق بمعرفة السنة الكبيسة راجع الرابط التالي:أربعة عشر معادلة لمعرفة السنة الكبيسة لأبي البراء ياسر خليل .

وعليكم السلام تفضل المعادلة من نوع الصفيف تجدها في العمود H قم بسحبها إلى الأسفل =INDIRECT("'القرآن كاملا'!D"&SUM(IF((F2='القرآن كاملا'!B$2:B$7000)*(G2='القرآن كاملا'!C$2:C$7000);ROW('القرآن كاملا'!C$2:C$7000);0))) تفضل التبويب الموضوعى لآيات القرآن1.rar

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

موضوع الحماية يعتبر من المواضيع الخاصة اي ان كل مبرمج له طرقه الخاصة في حماية برامجه وقد تكون هذه الطرق من ابتكاره هو ولم يطلع عليها احد فيبقى هذا من خصوصياته التي يبخل في الاعلان عنها ولا شك هو لا يلام في ذلك . ولو ضربت لك مثلا في احد الاعضاء كان يسأل هنا عن طريقة لحذف ملف ما ثم طريقة الاستعلام عنه ، طبعا هوفكر بطريقة عكس طريقتك . وعلى كل حال طرق الحماية كثيرة ومتنوعة وايضا طرق كسرها محتمل لا شك في ذلك لان الجميع يتفق انه لا يوجد حماية كاملة ، وسأسرد بعض الطرق الشائعة التي تستخدم فرادى واحيانا يجمع بين اكثر من طريقة لزيادة الحماية وضبطها : 1- الحماية بواسطة المعالج او الاقراص الثابتة او المنقولة 2- زراعة ملفات داخل النظام او حذفها 3- تسجيل بيانات محددة داخل النظام وتفسيرا لاستفساري السابق حين يتم تنصيب البرنامج لاول مرة يبحث البرنامج عن محبوبه داخل النظام ( في الجداول او في المجلدات او التسجيل او حتى تكون في خصيصة معينة لكائن ) فان لم يجدها يظهر فورم يطالب برقم التسجيل الذي ينبني على معادلة مسبقة الصنع معتمدة على عتاد الحاسوب وحين يدخل الرقم الصحيح يتم خلق هذا المحبوب في اوقات يحتاج المبرمج عرض برنامجه للتجربة مدة محددة او حسب ادخالات محددة وهنا يلجأ الى الحلول المناسبة التي تحفظ حقوقه عن العبث . ولكن مع ذلك ترى برامج عملاقة محمية تم اختراقها وفك طلاسمها طبعا التقنية تتطور وتتغير مع الزمن وهو الملاحظ حاليا في لغات البرمجة الاخرى التي تجمع بين واجهات الويب وواجهات وندوز فيمكن تطبيق الحماية اون لاين عبر الويب ، بحيث لا يعمل البرنامج الا بوجود الانترنت ، بهذه الطريقة تكون الشيفرة في جيب المبرمج آمل ان يكون في الاسطر السابقة زيادة معلومة وفائدة

السلام عليكم ورحمة الله وبركاته... الأصمعي حفظ لنا كثيراً من اللغة العربية ...أما الأعرابي فكان أباً للشعر وأماً.... أرجو أن تستمتعوا بمشاهدة هذا الفيديو بعيداً عن الأكواد والمعادلات رجوعاً إلى الأصالة والكرم...السمن العربي ...والعسل المصفى ...و...و...إلخ.

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله في أحد الموضوعات لأحد الأخوة الأعضاء كان قد طلب كيفية إرسال رسالة بريد إلكتروني (إيميل Email) باستخدام ملف إكسيل واليوم أقدم لكم الطريقة بالتفصيل من الألف إلى الياء ... وإن شاء الله تكون الطريقة ناجحة ومفيدة للجميع الخطوات اللازمة لعمل المطلوب : فتح حساب جديد على الـ Gmail إذا لم يكن لديك حساب وكيفية إنشاء حساب جديد مشروحة بالصور : نقوم بفتح برنامج الـ Outlook من قائمة Start ثم All Programs وندخل بيانات الحساب الذي أنشيء على الـ Gmail .. بهذا الشكل : وأخيراً وبعد عملية إنشاء الحساب وربط برنامج الـ Outlook بحساب الـ Gmail .. نقوم بفتح ملف إكسيل وفي العمود الأول ندخل الإيميلات المراد إرسال بريد إلكتروني لها .. وفي العمود الثاني نكتب اسم صاحب الايميل (اختياري) وفي العمود الثالث نكتب محتوى الرسالة المراد إرسالها .. وهذا هو الكود الذي سيقوم بمهمة إرسال رسائل البريد الالكتروني دفعة واحدة لكل الإيميلات المسجلة لديك .. ملحوظة مهمة جداً : من خلال محرر الأكواد يتم إضافة المكتبة التالية Microsoft Outlook Object Library من القائمة Tools ثم References .. Sub Mail_To_Friends() Dim SendTo As String Dim ToMSg As String Dim I As Integer For I = 2 To Cells(Rows.Count, 1).End(xlUp).Row SendTo = ThisWorkbook.Sheets(1).Cells(I, 1) If SendTo <> "" Then ToMSg = ThisWorkbook.Sheets(1).Cells(I, 3) Send_Mail SendTo, ToMSg End If Next I MsgBox "Done ...", 64 End Sub Sub Send_Mail(SendTo As String, ToMSg As String) Dim OutlookApp As Object Dim OutlookMail As Object Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.CreateItem(0) With OutlookMail .To = SendTo .CC = "" .BCC = "" .Subject = "Hello Officena" .Body = ToMSg .Send End With Set OutlookMail = Nothing Set OutlookApp = Nothing End Sub وأخيراً إليكم الملف المرفق مطبق فيه الكود وفيه نموذج لشكل ورقة العمل .. ويوجد زر أمر لعملية الإرسال .. وهذا هو الملف تقبلوا وافر تقديري واحترامي كان معكم أخوكم أبو البراء من منتدى أوفيسنا Send Mass Emails Through Outlook Using Excel VBA YasserKhalil Officena.rar

السلام عليكم ورحمة الله وبركاته ارجو ان نقدم جميعا حلولا متنوعه لهذه الحالة " المطلوب ربط الخلايا بعلامة / وترك او تخطى الخلايا الفارغة " بمعادلات او اكواد او اى طريقة حل

تفضل اخي فورمة ادخال.rar

اخي علي بدل هذا الكود الطويل جداً الملي بالشروط و الاستنتاجات اقترح علبك هذا الكود البسيط (جربه ولن نتدم) لانه لا يفرق بين الحرف الصغير a و الحرف الكبير A Sub DoMyOrder() Dim R As Integer Application.ScreenUpdating = False Sheets("Sheet1").Range("i2:l31").ClearContents For R = 2 To 31 For t = 2 To 5 With Sheets("Sheet1") Select Case UCase(.Cells(R, t).Value) Case "A" .Cells(R, t + 7) = 90 Case "B" .Cells(R, t + 7) = 80 Case "C" .Cells(R, t + 7) = 70 Case "D" .Cells(R, t + 7) = 60 Case "E" .Cells(R, t + 7) = 50 Case Else .Cells(R, t + 7) = "" End Select End With Next Next Application.ScreenUpdating = True End Sub

جزيت خيرا - اشكرك - زادتك الله علماً

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

تقصد التقريب لاقرب عشرة اضبط معيا وبعد منخلص نضبط الشكل والعلامة وما الي ذلك حساب داخل الفورم.rar

استاذي ياسر خليل سنوات ال 100 بسيطة مثل 1700، 1800، 1900، 2100، 2200، 2300، 2500، 2600 والسنوات الكبيسة من ال 100 هي السنوات الكبيسة، السنوات التالية: 1600، 2000، 2400 راجع الرابط ده https://support.microsoft.com/ar-sa/kb/214019

استاذ ياسر خليل انا جربتها على سنة 1900 لم تعمل وممكن حضرتك تشوف المعادلة دي كدة بتنفع مع اي سنة على افتراض أن السنة موجودة بالخلية A3 =IF(A3<>"",IF(OR(MOD(A3,400)=0,AND(MOD(A3,4)=0,MOD(A3,100)<>0)),"سنة كبيسة","سنة بسيطة"),"")

اخي الكريم السلام عليكم ورحمة الله وبركاته تم عمل المطلوب مع التقريب لاقرب رقم صحيح بالمرفقات مع تحياتي حساب داخل الفورم.rar

بصراحة ملفك يعتبر من المراجع المهمة حيث أنه اشتمل على كل آيات القرآن الكريم هذا ما استطعت عمله خدمة لكتاب الله تعالى أولا وقبل كل شيء ادخل علي شيت (القرآن كاملا) ثم اكمل كتابة أسماء السور مرتبة في العمود G ثانيا : لاحظ التعليمات ثالثا : تفضل التبويب الموضوعى لآيات القرآن2.rar

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

هل يوجد يوزر لديك له صلاحية محافظتين او ثلاث ... ام لليوزر اما صلاحية محافظة واحدة او كل المحافظات ...

وعليكم السلام أخي الحبيب أبو يوسف بارك الله فيك وجزاك الله كل خير .. والفضل لله عزوجل ثم لك في طرح هذا الموضوع ، فأنت من أوحى لي بفكرة الموضوع .. تقبل وافر تقديري واحترامي

أخي الكريم محمد عبد الناصر ادخل على التنسيق الشرطي وعدل الـ Format وغير اللون للون اللي إنت عايزه .. أخي الحبيب سليم ملف رائع بارك الله فيك وجزاك الله كل خير .. إنك لمدهش حقاً

ربنا يبارك فيك أخي الفاضل أحمد مرجان كلنا هنا أخوة وكلنا تلامذة في هذا الصرح الكبير ... تقبل وافر تقديري واحترامي

تفضل ... لكن بشرط عدم حذف اي سجل ... و ادخال البيانات بالتسلسل ... المتوسط المتحرك 2.rar

أشكرك يا أستاذ ياسر ولى الشرف انى أذكرك بحاجة تخص أستاذ كبير مثلك

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

للتنبيه حياك الله يا أخي

نعم , المعادلة تجدها في الخلية F1 وهي معادلة صفيف =IF(SUM(IF((((H3:AM3="X")*(OFFSET(H3:AM3;0;1)<>"X"))+((H3:AM3<>"X")*(OFFSET(H3:AM3;0;1)="X")));1;0))>=5;5;SUM(IF((((H3:AM3="X")*(OFFSET(H3:AM3;0;1)<>"X"))+((H3:AM3<>"X")*(OFFSET(H3:AM3;0;1)="X")));1;0))) تفضل Book14.rar

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

جرب هذا الملف نقل مجموع salim.rar

أخي الحبيب عبد الله فاروق كلنا نتعلم من بعضنا البعض ، فلولاكم لما تعلمت شيئاً فبكم ومنكم تعلمت تقبل وافر تقديري واحترامي

السلام عليكم الاخ الكريم والمعلم الفاضل اخى الحبيب سليم حاصبياسلمت يداك بكل خير حل ممتاز اخى الحبيب .... ويبقى ؟؟؟؟؟ هل يمكن حصر عدد X التى قبلها او بعده اى رمز خلاف X فى النطاق من H3 الى AN3عن طريق COUNTIF وبذلك نكون قد استغنينا عن المعادلات بمعادله واحده فقط ارجو ان يكون المطلوب تم ايضاح اقتباس

اخى محمد ابويوسف لباقة في الكلمات والاكواد ما شاء الله جزاك الله خيرا

وجزيت خيراً أخي وحبيبي حسام عيسى صقر المنتدى نورت الموضوع بردك الجميل

جزاكم الله خيرا يا ابوالبراء تقبل تحياتى

وجزيت خيراً أخي العزيز أسامة بمثل ما دعوت لي وزيادة تقبل وافر تقديري واحترامي

أخي العزيز جلال الجمال أحمد الله أنك متواجد فيما بيننا بعد طول انقطاع وأرجو أن تكون بيننا دائماً أخي الحبيب المتميز أبو يوسف بارك الله فيك وجزاك الله خيراً على نشاطك المثمر بالمنتدى ، جعله الله في ميزان حسناتك يوم القيامة أخي الغالي أبو حنين بعد طووووووووووووووول انقطاع أخيراً ظهرت على شاشات أوفيسنا .. عوداً حميداً يا رجل تقبلوا جميعاً وافر تقديري واحترامي

الخلل كما ذكرت لك هو في السطر For حبث ان الرقم بجب ان يكون 284 و ليس 183

استبدل الرقم 183 في السطر For i = 2 To 183 بـ 284 اليك الكود التالي الذي يقوم بنفس العمل و اسرع بكثير حيث انه يقوم بتجميع كل الاعمدة المطلوبة وحذفها دفعة واحدة Sub Delete_Zero() Dim rg_to_del As Range, i As Integer Application.ScreenUpdating = False For i = 2 To 284 If Cells(284, i) = 0 Then If rg_to_del Is Nothing Then Set rg_to_del = Cells(284, i) Else Set rg_to_del = Union(Cells(284, i), rg_to_del) End If End If Next i rg_to_del.EntireColumn.Delete Application.ScreenUpdating = True End Sub

تفضل اخى الكريم جرب المعادله بهذا الشكل ( على حسب ما فهمت من طلبك =IF(AND(C6>=50;C6<=60);"Mahmoud";"") تقبل تحياتى

أخي الحبيب محمد الريفي نشتاق لموضوعاتك الجديدة بشكل دائم ولتواجدك فيما بيننا لدي دالة معرفة تقوم بالأمر ولكني سأكتفي بهذه المعادلة البسيطة لتؤدي الغرض =SUBSTITUTE(TRIM(A1&" "&B1&" "&C1&" "&D1&" "&E1)," ","/") تقبل تحياتي

ان كيدهن عظيم اخي الكريم محمد ابو صهيب الزوج فكر بالطريقة التقليدية وهو عند القفز يمتنع ويتركها دا بقي لما فاض به من العيشه اللي وصلته لكدا اما الزوجة فكرت بطريقة ازكى شوية وهي. - هتقفز معاه لما الاتنين يقفزو تفتح مظلتها لتنجو وتترك الزوج يلقى مصرعه هنا الزوجة الاشد مكراً تقبل تحياتي

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

جرب كلمة officena حرف الـ O صغير ... بالشكل ده officena

السلام عليكم دالة الصفيف kh_MatchArray لارجاع ارقام صفوف سجلات حسب شروط الوسائط: عبارة عن صفيف يحقق (شرط / شروط) في عمود معين من قاعدة البيانات ادخل الشروط التي تريدها من 1 الى 30 الاستخدام : كشوفات الحساب التقارير بانواعها الميزة : لا ترهق الجهاز في المثال المرفق استخدمتها لقاعدة بيانات عدد سجلاتها اكثر من 15000 سجل والسبب انها معادلة وحدة نتائجها صفيف لهذا توضع على اكثر من خلية ولكن مكان تعديلها الخلية الاولى لوضعها مع تحديد باقي الصفوف الموضوعة فيها . اضغط F2 لتحرير الصيغة ثم اضغط CTRL+SHIFT+ENTER اذا حاولت تعدل اي خلية موضوعه فيها الدالة (جزء من صفيف الدالة) تظهر لك رسالة ( لا يمكنك تعديل جزء من صفيف) استخدم حينها ESC لانهاء تحرير الدالة . طبعا نتائجها ارقام الصفوف التي تحقق الشرط اعلى نطاق الدالة والاخرى رقم صفر بمعنى لا يحقق الشرط وهي اسفل النطاق تضعها في عمود يمين او يسار الكشف المتبقي علينا نستخدم دالة INDEX لاظهار الاعمدة الت نريدها من قاعدة البيانات كود الدالة: Option Explicit '============================================= '============================================= Function kh_MatchArray(ParamArray Array1() As Variant) Dim Ar() As Long Dim x As Integer, xx As Integer, xxx As Integer Dim iCont As Long, i As Long, ii As Long xx = UBound(Array1) If xx = -1 Then GoTo kh_Err iCont = UBound(Array1(0), 1) ReDim Ar(1 To iCont, 1 To 1) For i = 1 To iCont xxx = 1 For x = 0 To xx xxx = xxx * IIf(CBool(Array1(x)(i, 1)), 1, 0) Next If xxx Then ii = ii + 1: Ar(ii, 1) = i Next kh_MatchArray = Ar kh_Err: Erase Ar End Function المرفق 2003-2007 kh_MatchArray.rar

بارك الله فيك و جزاك الله خيرا