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

السّلام عليكم و رحمة الله و بركاته قمّة الفرح و منتهى السّعادة و أنا أطرق باب بيتي التعليمي " أوفيسنا " .. حامِلاً معي حقيبة أكوادي .. ومن ضمنها " الوابْ بْروصرْ " من محرّر الأكواد ومن خلال " صندوق الأدوات " إضغط على السّهم ..كليك يمين ..أدوات إضافية ثم من خلال القائمة المنسدلة .. قم يالتأشير على خانة " الوابْ بْروصرْ "..مثلما بالصّور المرقمّة بالتّرتيب : وها قد أصبح لديك الآن على اليوزرفورم كائن يسمّى " الوابْ بْروصرْ " قمْ بإضافة هذا المولود الجديد على اليوزرفورم كإضافة أي كائن آخر مثله مثل الليبل أو التاكست-ليست-كومبو بوكس من حيث الحجم كالتّكبير أو التّصغير .. و إذا كنت مرهقًا ..لا عليك .. فقط بالضغط على هذا " الوابْ بْروصرْ " في هذا الملف المرفق رقم 1 .. ثم نسخ و لصق بملفك الشخصي .. مع نقل الأكواد طبعًا .. و التّغيير في العبارة أو العبارات التي تودّ إظهارها على الشّريط المتحرّك قد يتساءل أحد منّا ولو بنفسه .. وهل نحن بحاجة بأن تعرّفنا على هذا " الوابْ بْروصرْ " يا عبد العزيز البسكري ..!!؟؟ و سأجيب بكل بساطة .. لا .. طبعًا .. أنا لا أتكلم بهذا الموضوع عن الطّائرة ..و إنّما قصدتُ جناحَ الطائرة المفقود .. وهو ظهور الشّريط المتحرّك من اليمين لليسار بشكل يواكب لغتنا الأم .. اللّغة العربية .. و نمنحُها أسمى معانيها وضعتُ ملفيْن مرفقيْن ..للمقارنة بينهما و ستلاحظون أنّ التّغيير وقع فقط بجزئية تغيير الاتّجاه .. أساتذتي الأفاضل قد يكون الموضوع بسيطًا لكن عسى أن ينتفع به المبتدئون أمثالي و السّلام عليكم و رحمة الله و بركاته خالص إحتراماتي الواب بروصر يمين يسار.rar

سادسا :- اجبار المستخدم على الاختيار من الكمبوبوكس يوجد طريقتين الطريقه الاولى :- هى استخدام الخاصيه Style اثناء شرحنا لخصائص الكمبوبوكس فى مرحلة التصميم تكلمنا عن الخاصيه Style ودا نسخ الجزئيه الخاصه بالخاصيه Style من شروحتنا السابقه الخاصيه ( Style ):- وهى بنظرى من اهم الخصائص للكمبوبوكس زى ما احنا عارفين لفتح القائمة الخاصه بالكمبوبوكس للاختيار منها لابد من الضغط على السهم لتفتح القائمه ولكن هذه الخاصيه تتيح للمستخدم التحكم فى وقت فتح القائمة الخاصه بالكمبوبوكس فلها خيارين الخيار الاول Fm StyleDropDown Combo - 0 :- هو الافتراضى لابد من الضغظ على السهم لفتح القائمة كما تتيح للمستخدم كتابة اى شئ بالكمبوبوكس غير موجود بالقائمه بمعنى لا تلزم المستخدم من الخيار من القائمة والخيار الثانى Fm StyleDropDown List - 2 : -هو فتح القائمة من خلال الضغط على السهم او بمجرد وقوف مؤشر الماوس على الكمبوبوكس وكمان ميزة ثالته وهى مهمه جدا هو انه لا يمكن للمستخدم كتابة اى شئ فى الكمبوبوكس يعنى كانك عامل خاصيه حمايه للكمبوبوكس ولا سبيل امام المستخدم الا من الاختيار من القائمه -------------------------------------------------------------------------------------------- الطريقه الثانية :- استخدام الخاصيه MatchFound عايزين نعمل كود يقوم باختبار قيمة الكمبوبوكس هل هى موجوده بالقائمه او لا ؟ لو الكمبوبوكس التطابق مع القائمة = خطأ نفذ الكمبوبوكس فارغ ( دا شرح الكود كدا بالبلدى وحنا قاعدين على المصطبه) لتحويل الكلام اللى بالبلدى ده الى لغة البرمجه تابع معايا لو نستبدلها بـ IF (يعنى قاعدة IF) الكمبوبوكس نستبدله باسم الكمبوبوكس المراد العمل عليه وهو على سبيل المثال Me.ComboBox1 التطابق مع القائمه دى الخاصيه Match Found بمجرد كتابة اسم الكمبوبوكس ثم . ثم حرف M ستجد الفيجوال بيسك يعرض لك قائمه للاختيار شاهد الصوره التاليه = خطأ False ( أى ان القيمة المختاره غير موجوده بالقائمه ) نفذ Then الكمبوبوكس فارغ " " شاهد الكود لما نجمع الكلام ده بقى هيكون كالتالى If Me.ComboBox1.MatchFound = False Then ComboBox1 = "" End If طيب ما هو وقت تنفيذ الكود وقت التنفيذ انت اللى بتحدده مثلا ممكن يكون فى حدث تغيير الكمبوبوكس ()Private Sub ComboBox1_Change Private Sub ComboBox1_Change() If Me.ComboBox1.MatchFound = False Then ComboBox1 = "" End If End Sub وبكدا لو عندك قائمه الكمبوبوكس وليكن بها ( مصر & السعودية & السودان & الجزائر ) والمستخدم تجاهل هذه القائمة وراح يكتب تونس بمجرد بس كتابة حرف ت سوف يقوم الكود بالعمل مش هيلاقى دوله فى القائمة تبدأ بحرف ت اذن تحقق شرط عدم التطابق فهيقوم بمسح حرف ت ممكن واحد يفتكر فى عفريت مسح الحرف يعنى كل ما تكتب شئ غير موجود بالقائمه هتلاقيه بيتمسح فورا ----------------------- ممكن نكتب الكود فى وقت حدث الخروج من الكمبوبوكس Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Me.ComboBox1.MatchFound = False Then ComboBox1 = "" End If End Sub يعنى المستخدم بمجرد ما يكتب تونس ويضغط انتر للانتقال الى عنصر اخر على الفورم هتلاقى الكود بيتنفذ ويمسك المستخدم من قفاه ويقوله تعالى تونس غير موجوده فى قائمة الكمبوبوكس وهيمسح تونس يعنى كأن المستخدم مكتبش اى حاجه ومازل الكمبوبوكس قيمته فارغه ممكن المستخدم يتجنن هو ايه اللى بيحصل هو ليه كل ما اكتب تونس يتم مسحها هو فى عفريت ؟؟ ما عفريت الا بنى ادم فعلشان نريحه نظهر له رساله تفيد بانه يجب الاختيار من القائمه Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Me.ComboBox1.MatchFound = False Then ComboBox1 = "" MsgBox " الرجاء الاختيار من القائمة", vbCritical, "خطأ" End If End Sub قمنا باضافه هذا السطر بالكود قبل نهاية IF MsgBox " الرجاء الاختيار من القائمة", vbCritical, "خطأ" الرساله تتكون من ثلاث اقسام يفصل ما بين كل قسم وقسم علامة , القسم الاول وهو الرساله " الرجاء الاختيار من القائمه" وتم وضعها بين علامتى تنصيص ( وهو قسم اجبارى) القسم الثانى وهو نوع الرساله واظهار علامه لها فكتبنا Vbcritical رساله خطأ ( وهو قسم اختيارى يمكن الاستغناء عنه ) القسم الثالث وهو عنوان الرساله فكتبنا "خطأ" وممكن تكتب اى عنوان كما تشاء ( وهو قسم اختيارى يمكن الاستغناء عنه) فالاساس فى الرساله هو نص الرساله " الرجاء الاختيار من القائمة " MsgBox فأذا ارد اظهار علامه للرساله او عنوان لها قم باضافه القسم الثانى والثالث او استكفى بالقسم الاول اذا حبيت شاهد الرساله عند الاختيار الخاطئ من المستخدم هل يمكن كتابة الكود فى سطر واحد ؟ نعم يمكن ذالك Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Me.ComboBox1.MatchFound = False Then: ComboBox1 = "": MsgBox "الرجاء الاختيار من القائمة", vbCritical, "خطأ": Exit Sub End Sub كما تشاهدون الكود انه فى سطر واحد فقط وذالك باستخدام : : ( تكتب من خلال الضغط على شيفت + حرف ك بالعربى ) واستبدلنا عبارة End if بــ Exit Sub -------------------------------------------------------------------------------------------------------------------- الحمد لله انتهينا من شروحات الكمبوبوكس والى لقاء اخر من حلقات سلسلة علمنى كيف اصطاد ان شاء الله هيكون عن الـــ Frame انتظرونا تقبلوا تحياتى

السلام عليكم ورحمة الله وبركاته أحبائى وأساتذتى وأعضاء هذا الصرح العلمى الهائل الذى مهما قدمت له لن أوفيه حقه فيما تعلمت منه الفترة الماضية وبعد قدمت من قبل موضوع بعنوان معادلة بحث جميلة جدا على الرابط ولكن بالمعادلات اليوم أقدم لكم نفس الفكرة ولكن بالأكواد الأكواد المستخدمة الكود الأول فى حدث الشييت : Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Cells(2, 2)) Is Nothing Then: names_by_letters End Sub والكود الثانى يوضع ب Module Sub names_by_letters() Dim myRange As Range Dim i As Integer Dim x As Range i = 2 lr = Cells(Rows.Count, 1).End(xlUp).Row Range("c2:c" & lr).ClearContents Set myRange = Range("a2:a" & lr) For Each x In myRange If Mid(x, 1, 1) = [b2] Then Cells(i, 3).Value = x i = i + 1 End If Next x End Sub أرجوا أن يستفاد منه الجميع والله ولى التوفيق Find By VBA Code.rar

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

أخى أبا عبدالرحمن جرب هذا الملف قد يقيدك Test .rar

أو يمكن استخدام المعادلة بهذا الشكل =(C1-(A1+B1))*LOOKUP(SUM(A1:B1),{0,250,500,1000},{6,6.5,7,0}%)

أخى ليمونة جرب الملف التالى ملحوظة 1 يتم ادخال التاريخ فى الخلية U5 تم اضافة معادلة ترقيم من الخلية A6 الى A31 للحصول على ترقيم سليم قبل وبعد الفلترة ملحوظة 2 : لكى يعمل الكود يجب أن تكون مكتبة الورد نشطة لديك يكون ذلك من خلال فتح الفيجوال بيزك و من تبويب Tools اختر References ثم المكتبة Microsoft Word 12.0 Object Library ( الرقم يختلف حسب اصدار الأفيس ) ثم OK Excel Range To Word V 1.rar

السلام عليكم ورحمة الله وبركاته إخواني الأحباب في المنتدى الغالي هل فكرت يوماً ؟ إذاً أنت موجود .. لأن الحكمة بتقول : أنا أفكر إذاً أنا موجود ، وبتعديل بسيط ممكن نقول : أنا أؤمن بالله إذاً فالله موجود وأنا حي القلب قبل حياة الجسد سرحت اعذروني أقدم لكم اليوم كود جديد ، يقوم الكود كما هو موضح بالعنوان (والموضوع بيبان من عنوانه ..فمحدش يتوه مني عشان أنا متعمد أتوهكم) ..كما هو موضح يقوم الكود بتنفيذ الماكرو أو الإجراء الفرعي عدد معين من المرات ، يمكنك أن تحدد عدد المرات في الملف المرفق قمت بوضع عدد المرات في الخلية C3 ويمكن تغييره بالطبع ، كما يمكن أيضاً (عشان الناس متقولش إني بخلان عليكم بمعلومة) ممكن أن تغير في الكود لتضع عدد مرات التكرار الذي ترغبه داخل الكود ، وذلك من خلال تغيير هذا السطر nTimes = Range("C3").Value إلى هذا السطر nTimes = 3 إذاً فأنت حر في اختيارك لطريقة وضع قيمة المتغير المرتبط بعدد مرات التكرار وإليكم الكود بالشكل الكامل (والكمال لله وحده) 'تعريف المتغير الذي يمثل عداد لعدد مرات تنفيذ الماكرو Dim I As Integer Sub RunMacroNTimes() 'تعريف المتغير الذي يمثل عدد مرات تنفيذ الماكرو Dim nTimes As Integer 'إلغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'وضع القيمة صفر للعداد I = 0 '[C3] ليساوي قيمة الخلية [nTimes] تعيين قيمة للمتغير nTimes = Range("C3").Value 'حلقة تكرارية لتكرار تنفيذ الماكرو طبقاً لقيمة الخلية Do While I < nTimes 'زيادة قيمة العداد بمقدار واحد في كل حلقة تكرارية I = I + 1 'استدعاء الماكرو المراد تنفيذه Call Test 'الانتقال داخل الحلقة التكرارية إلى أن تساوي قيمة العداد قيمة الخلية Loop 'إظهار رسالة تفيد بعدد مرات تنفيذ الماكرو MsgBox "تم تنفيذ الماكرو " & I & " مرات" 'إعادة تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True End Sub Sub Test() MsgBox "مرحباً بكم إخواني .. الترحيب رقم " & I End Sub وعشان خاطر عيون حبايبي اللي زعلانين مني (وهما عارفين مين .. وكل لبيب بالإشارة يفهم .. ومش عايز حد يكون ساخـ (هـ) ـــر مني) قمت بشرح أسطر الكود للاستفادة منه في أكواد أخرى كما أقدم لكم ملف مرفق للإطلاع عليه (ودا عشان الناس الكسلانة .. شايف مختار بيحمل الملف المرفق .. لا إنت لا إنت طبقه بنفسك) وأخيراً تقبلوا تحياتي ودمتم في رعاية الله Run Macro Number Of Times YasserKhalil.rar

الله عليك يا أ / ياسر كود أكثر من رائع أخى الحبيب تسلم يمينك ومرفق أيضا المرفق الأول للحل بدون كماية VBA بعد إذنك يا أ / ياسر فرز المكرر بإجمالى مبيعاته مرتب أبجديا.rar

أخي الكريم نور وحيد جرب الكود التالي عله يفي بالغرض Sub Summary() Dim I As Long, J As Long, M As Long, N As Long, LR As Long, V, ZUM Dim C As Collection Set C = New Collection Application.ScreenUpdating = False On Error Resume Next For I = 3 To Rows.Count V = Cells(I, 1).Value If V = "" Then N = I - 1 Exit For End If C.Add V, CStr(V) Next I On Error GoTo 0 M = 3 For I = 1 To C.Count Cells(M, 5) = C.Item(I) ZUM = 0 For J = 3 To N If Cells(J, 1).Value = Cells(M, 5).Value Then ZUM = ZUM + Cells(J, 2).Value End If Next J Cells(M, 6).Value = ZUM M = M + 1 Next I LR = Range("E" & Rows.Count).End(xlUp).Row Range("E3:F" & LR).Sort Key1:=Range("E1:E" & LR), Order1:=xlAscending, Header:=xlNo Application.ScreenUpdating = True End Sub وإليك الملف المرفق الخاص بك Unique Items With SUM & Sort YasserKhalil.rar

أثراءً للموضوع جرب هذه المعادلة =(C1-(A1+B1))*VLOOKUP(A1+B1,{0,0.6;250,0.65;500,0.7},2)

السلام عليكم ورحمة الله وبركاته أسعد الله أوقاتكم جميعا وكنتم جميعا فى أحسن حال أتقدم إليكم اليوم بمعادلة جميلة جدا جدا تقوم بعمل بحث فى عمود عن أول حرف عن طرق وضع الحرف المراد إظهار النتائج التى تبدأ بهذا الحرف فى خلية ما فيظهر فى العمود المقابل كل الاسماء التى تبدأ بهذا الحرف المعادلة معادلة صفيف يعنى الضغط على Ctrl+Shift-Enter وليس Enter {=IFERROR((IF(ROW()=2;INDIRECT("$A$"&(MATCH(1;(((--($B$2=LEFT($A$1:$A$100;1)))));0)));((INDIRECT("$A$"&(MATCH(1;(((--($B$2=LEFT(INDIRECT(IF(C1="";"";"$A$"&(MATCH(C1;$A$1:$A$101;0)+1))&":$A$100");1)))));0))+(MATCH(C1;$A$1:$A$101;0)))))));" ")} مرفق ملف به المعادلة والتنفيذ أرجوا من الله العلى القدير ان يستفاد منه الجميع Find.rar

=(C1-(A1+B1))*IF(SUM(A1:B1)<250,6%,IF(AND(SUM(A1:B1)>=250,SUM(A1:B1)<500),6.5%,IF(AND(SUM(A1:B1)>=500,SUM(A1:B1)<1000),7%))) جرب المعادلة بهذا الشكل

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

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

السلام عليكم اخي الكريم ياسر فتحي الصبر الصبر ان شاء الله خير رغم قراءتي لطلبك سابقاً الا اني لم اوفق لفكرهعمليه تخدم ملفك السبب كبر حجم البيانات ان شاء الله لي محاوله ان وفقت سوف ارفقه تحياتي

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

أخي ابو عمر جرب الملف التالي Search_by any_letters.zip

السلام عليكم ورحمة الله وبركاته إخواني الكرام .. قد يكون موضوع الكسر موضوع شائك وفيه خلاف ، ولكن ربما يكون مفيد لصاحب العمل نفسه ، حيث أنه معرض لنسيان الباسورد الذي تم وضعه على محرر الأكواد .. الموضوع مميز لأنه يقوم بكسر الحماية بدون برامج على الإطلاق ..وبدون AddIns وبدون الاستعانة بأية برامج مجانية أو مدفوعة !! كسر محرر الأكواد بالأكواد نفسها (قنبلة الموسم) وعلى رأي المثل : علمته رمي السهام فلما اشتد ساعده رماني .. الكود قليل الأصل !! محفظش الجميل للبيئة اللي هو منها ، لأنه كسر بيئة محرر الأكواد !!! Sub HackVBA() Open "C:\Users\Future\Desktop\Test.xls" For Binary As #1 Put #1, 1, Replace(Input(LOF(1), 1), "DPB=", "DPX=", , 1) Close Workbooks.Open "C:\Users\Future\Desktop\Test.xls" End Sub المطلوب فقط أن تغير مسار الملف المراد كسره داخل الكود ، والمسار يوضع بين أقواس تنصيص .. أترككم مع الفيديو عله ينال إعجابكم وتستفيدوا منه إن شاء المولى .. ولا تنسونا من اللايكات على اليوتيوب !!!!! ....أكرر اللايكات على اليوتيوب ..فضلاً لا أمراً تقبلوا تحيات أخوكم أبو البراء

أخى الحبيب / ياسر العربى عمل متميذ وأكثر من رائع جزاك الله خيرا

الأول إخفاء كل التبويبات وزر الأوفيس Sub hhh() Application.ExecuteExcel4Macro "show.toolbar(""ribbon"",false)" End Sub الثاني إظهار كل التبويبات وزر الأوفيس Sub sss() Application.ExecuteExcel4Macro "show.toolbar(""ribbon"",true)" End Sub

السّلام عليكم و رحمة الله و بركاته قلت لك و أكررها اليوم و غدا و كل يوم إذا كان في العمر بقية : هداياك استثنائية تسلم أستاذي القدير مختار حسين محمود بارك الله فيك و زادها بميزان حسناتك فائق إحتراماتي

السّلام عليكم و رحمة الله و بركاته بارك الله فيك أستاذي و أخي الغالي " ياسر فتحي البنّا " جزئيات و أكواد مهمّة تتحفنا بها بين الحين و الآخر .. واصل بلا فواصل و إنّا لك متتبّعون جزاك الله خيرًا و زادها بميزان حسناتك أخوك / عبد العزيز البسكري

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

السّلام عليكم و رحمة الله و بركاته أخي الكريم محمد عبد السّلام ..ما قمت به هو فقط تعديلات بسيطة على ملف الأخ أبو عبد الرحمن البغدادي ..يمكنك تغيير اسم المستخدم و كلمة المرور الخاصّتيْن بك مثلما توضّحه الصّورة أدناه ..و أي إضافات أو تغييرات تريدها .. رجاءً .. لا تتردّد .. فالمنتدى فاتح ذراعيْه تِرحابًا بالجميع .. اسم المستخدم :123 كلمة المرور :123 مع خالص إحتراماتي محمد عبد السلام.rar

الله ينور عليك أخي الغالي ياسر العربي مجهود رائع ... بالنسبة لـ 64 بت يمكن نسخ الملفات لكلا المسارين لأنني واجهت بعض رسائل الخطأ عند نسخ الملفات لمسار الـ 64 حاول تشوف حل لموضوع زر الامر اللي قلت لك عليه .. مش بيظهر البرنامج بشكل مناسب عند الضغط على هذا الزر "بحث وإدخال"

السّلام عليكم و رحمة الله و بركاته أخي الكريم محمود330 .. و بعد إذن الأستاذ القدير سليم حاصبيا .. جزاه الله خيرًا و زادها بميزان حسناته ..و مادمتَ استصعبتَ الأكواد و لتنويع الأساليب ..طريقة أخرى للبحث بالقائمة المنسدلة عن طريق الكومبوبوكس قم بالتغيير فقط مثلما توضحه الصّورة أدناه .. تسمية نطاق البحث "Mahmoud" .. التغيير في اسم الشيت و في الخلية التي تود إظهار نتيجة البحث بها مع فائق إحتراماتي قائمة منسدلة.rar

Sub GrabBills() Dim rFind As Range, sAddr As String, Rng As Range, RngDel As Range, SH As Worksheet, R As Range, WS As Worksheet, VarList Set SH = Sheets("استدعاء فاتورة") Set WS = Sheets("فاتورة") VarList = SH.Range("A3").Value Application.ScreenUpdating = False SH.UsedRange.Offset(3).Clear If IsEmpty(SH.Range("A3")) Then MsgBox "أدخل كود العميل المطلوب استدعاء فواتيره", 64: Exit Sub With WS.Columns(3) Set rFind = .Find(VarList, LookIn:=xlValues, LookAt:=xlWhole) If IsEmpty(SH.Range("C3")) Then If Not rFind Is Nothing Then sAddr = rFind.Address Set RngDel = rFind.CurrentRegion Do Set RngDel = Union(RngDel, rFind.CurrentRegion) Set rFind = .FindNext(rFind) Loop While rFind.Address <> sAddr sAddr = "" End If Else If Not rFind Is Nothing Then sAddr = rFind.Address Do If Month(rFind.Offset(-3, -1)) = SH.Range("C3") Then If RngDel Is Nothing Then Set RngDel = rFind.CurrentRegion Else Set RngDel = Union(RngDel, rFind.CurrentRegion) End If End If Set rFind = .FindNext(rFind) Loop While rFind.Address <> sAddr sAddr = "" End If End If End With If Not RngDel Is Nothing Then RngDel.Copy SH.Range("A5") End If Set rFind = Nothing Set RngDel = Nothing Set SH = Nothing Application.ScreenUpdating = True End Sub أخي الكريم طارق طلعت يرجى عدم توجيه الموضوع لعضو بعينه ..لما يمنع الخير عن نفسك ..فلربما كان لدى أحد الأخوة الأفاضل بالمنتدى حل أفضل من الذي قد أقدمه ..أو لربما أعجز عن تقديم المساعدة لأي سبب كان عموماً ..إليك الكود التالي وإن شاء الله يفي بالغرض ويعمل مع كود العميل ومع الشهر إذا أردت التعامل مع شهر معين في الخلية C3 Grab Bills YasserKhalil.rar

لحل الاخطاء يرجى نسخ الملفات الثلاثة الاتية اذا كنت 64 بت c:\windows\syswow64\ اذا كنت 32 بت c:\windows\system32\ محتار انسخ في المكانين عادي وبعد شغل الملف دا كمسئول الملف دا مرفق هنا نزله وافتح كمسئول بعد نسخ الملفات طبعا للنظام ونقوم بفتح البرنامج بردو كمسئول تسجيل الادوات فتح كمسئول.rar وشكرا علي ملاحظاتكم

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

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

لا حول ولا قوة الا بالله

جرب هذا الملف show_names_1_2_by letters Arrays.zip

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

جرب هذا التعديل على ملف الداتا الكامل على ملفك المرفق المختصر يعطي نتائج سليمه Private Function Ali(Ln As Long, Vl, Bl As String, Bln As Boolean) Dim Shet As Worksheet Dim Do_Ali Dim Ar() As Variant Dim iCnt& Dim X, A On Error Resume Next Set Shet = Sheets("Report") Set Do_Ali = CreateObject("Scripting.Dictionary") With Application .ScreenUpdating = False .EnableEvents = True DoEvents With Shet Lr = .Cells(.Rows.Count, 2).End(xlUp).Row Ar = .Range("A2:F" & Lr).Value: A = Bl For R = LBound(Ar, 1) To UBound(Ar, 1) If Ar(R, 3) = A Then If Not Bln Then If Vl = 3 Then ZZ = Ar(R, 2): ZZZ = Ar(R - 1, 2) If ZZZ <> ZZ Then X = X + 1 End If End If If Vl = 4 Then X = X + Ar(R, 6) End If End If If Do_Ali.exists(Ar(R, Ln)) Then Do_Ali.Item(Ar(R, Ln)) = Do_Ali.Item(Ar(R, Ln)) + 1 Else Do_Ali.Add Ar(R, Ln), 1 End If End If Next Ali = IIf(Vl = 1, Do_Ali.Count, X) End With .ScreenUpdating = True .EnableEvents = False End With Erase Ar Set Do_Ali = Nothing Set Shet = Nothing End Function Sub Ali_Count() Dim Sh As Worksheet Dim Sht As Worksheet Dim R, Rr, Cll, Lrr Set Sh = Sheets("Rank") Set Sht = Sheets("Report") With Sh Lrr = Sht.Cells(Rows.Count, 2).End(xlUp).Row Sht.Sort.SortFields.Add Key:=Sht.Range("A2:A" & Lrr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With Sht.Sort .SetRange Sht.Range("A1:F" & Lrr) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Rr = 10: Cll = 13 For R = Rr To Cll If .Cells(R, 2) <> "" Then .Cells(R, 4) = Ali(1, 4, .Cells(R, 2), False) .Cells(R, 9) = Ali(1, 3, .Cells(R, 2), False) .Cells(R, 14) = Ali(4, 1, .Cells(R, 2), True) .Cells(R, 19) = Ali(1, 1, .Cells(R, 2), True) End If Next End With MsgBox "Greetings with Engineer / Yasser Fathi Al-Banna " End Sub

البرنامج مش بيفتح عندى يا حلو حاول شوف المشكله يمكن محتاج التاتش بتاعك

أسعد الله أوقاتكم بكل خير فيما يلي الدرس الخامس عشر من دورة "إكسيل 2013 المستوى المتقدم" بعنوان دوال البحث المتقدمة الجزء الخامس-دالة أوفسيت OFFSET FUNCTION حيث سنتعرف على العديد من الاستخدامات المفيدة والمذهلة لهذه الدالة القوية أتمنى لكم مشاهدة ممتعة ومفيدة يمكنكم تحميل ملفات التمارين الخاصة بهذه الدورة من خلال الرابط التالي: http://www.4shared.com/rar/QvwJQLddce/_-__.html لمتابعة الموضوع الرئيسي للدورة يمكنكم فتح الرابط التالي حيث جميع الدروس موجودة: دورة اكسيل 2013 المستوى المتقدم دمتم بخير أخوكم م/نضال الشامي

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

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

السّلام عليكم و رحمة الله و بركاته أسعدتني كلماتك العطرة أستاذي العزيز وائل أحمد المصري بحقّي بارك الله فيك .. جزاك الله خيرًا و زادها بميزان حسناتك نصف الكلام و الإعجاب الآخر يكمله لك الأخ العزيز أبو عبد لرحمن البغدادي صاحب الموضوع فائق إحتراماتي

كلمة السر واسم المستخدم 123

جرب هذا الشيء الحضور والإنصراف salim.zip

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

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

السلام عليكم لو افترضنا أن التكست بوكس هو TextBox1 ضع الكود التالي في موديول الفورم Option Explicit Private Const KL_NAMELENGTH = 9 #If Win64 Then Private Declare PtrSafe Function LoadKeyboardLayoutA Lib "user32" (ByVal pwszKLID As String, ByVal flags As Long) As LongPtr Private Declare PtrSafe Function ActivateKeyboardLayoutA Lib "user32" Alias "ActivateKeyboardLayout" (ByVal HKL As LongPtr, ByVal flags As Long) As LongPtr Private Declare PtrSafe Function UnloadKeyboardLayoutA Lib "user32" Alias "UnloadKeyboardLayout" (ByVal HKL As LongPtr) As Long Private Declare PtrSafe Function GetKeyboardLayoutNameA Lib "user32" (ByVal pwszKLID As String) As Long #Else Private Declare Function LoadKeyboardLayoutA Lib "user32" (ByVal pwszKLID As String, ByVal flags As Long) As Long Private Declare Function ActivateKeyboardLayoutA Lib "user32" Alias "ActivateKeyboardLayout" (ByVal HKL As Long, ByVal flags As Long) As Long Private Declare Function UnloadKeyboardLayoutA Lib "user32" Alias "UnloadKeyboardLayout" (ByVal HKL As Long) As Long Private Declare Function GetKeyboardLayoutNameA Lib "user32" (ByVal pwszKLID As String) As Long #End If #If Win64 Then Dim HKLsystem As LongPtr, HKLarabic As LongPtr #Else Dim HKLsystem As Long, HKLarabic As Long #End If Private Sub TextBox1_Enter() ActivateKeyboardLayout HKLarabic End Sub Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) ActivateKeyboardLayout HKLsystem End Sub Private Sub UserForm_Initialize() HKLsystem = LoadKeyboardLayout(GetKeyboardLCID) HKLarabic = LoadKeyboardLayout(1025) End Sub Private Sub UserForm_Terminate() ActivateKeyboardLayout HKLsystem UnloadKeyboardLayout HKLarabic End Sub Private Function GetKeyboardLCID() As Long Dim KLID As String * KL_NAMELENGTH GetKeyboardLayoutNameA KLID GetKeyboardLCID = CLng("&H" & KLID) End Function #If Win64 Then Private Function LoadKeyboardLayout(ByVal LCID As Long) As LongPtr #Else Private Function LoadKeyboardLayout(ByVal LCID As Long) As Long #End If Dim KLID As String * KL_NAMELENGTH KLID = Right(String(KL_NAMELENGTH - 1, "0") & Hex(LCID), KL_NAMELENGTH - 1) & vbNullChar LoadKeyboardLayout = LoadKeyboardLayoutA(KLID, 0) End Function #If Win64 Then Private Function UnloadKeyboardLayout(ByVal HKL As LongPtr) As Boolean #Else Private Function UnloadKeyboardLayout(ByVal HKL As Long) As Boolean #End If UnloadKeyboardLayout = UnloadKeyboardLayoutA(HKL) <> 0 End Function #If Win64 Then Private Function ActivateKeyboardLayout(ByVal HKL As LongPtr) As LongPtr #Else Private Function ActivateKeyboardLayout(ByVal HKL As Long) As Long #End If ActivateKeyboardLayout = ActivateKeyboardLayoutA(HKL, 0) DoEvents End Function

السلام عليكم ورحمة الله أخواني الكرام، بارك الله فيكم جميعا على كل هذا المجهود وجازاكم الله خيرا... ولإثراء الموضوع أكثر، في الملف المرفق (ملف الأخ الكريم سليم) تجدون تعديلا بسيطا على معادلتي الأخوين الكريمين (ياسر و سليم)، حيث يتم البحث على البيانات بالحروف الأولى منها مهما كان عددها وليس بالضرورة الحرف الأول فقط... أخوكم بن علية Find Salim + Yasser.zip

السلام عليكم ورحمة الله وبركاته في المشاركة السابقة nTimes هتكون هي count لعمود ارقام الحسابات في صفحة مؤقت واقوللك على مثل اقرب لو انت بتستخدم اليومية الانجليزية فاحيانا تجد السند الواحد يحتوي على اكثر من بيان يحتاج الى تبويبه لحسابات مختلفة وهنا تكرار البيان الواحد مطلوب نسخه لاكثر من مرة حسب عدد مرات التبويب وكمثال عند اجراء تسوية مستحقات موظف بمناسبة نهاية عقده فستجد السند الواحد يحتوي على بيانات كالتالي عدد ايام التشغيل رصيد اجازات مستحقة مكافئة نهاية الخدمة اضافات اخرى جزاءات تامينات مستحقة على الموظف ضرائب كسب عمل مستحقة استقطاعات اخرى كل هذه التبويبات ستحمل في البيان وصف واحد وهو تسوية مستحقات العامل س بقسم ص تحياتي للجميع

السلام عليكم ورحمة الله وبركاته بارك الله فيك اخي الكريم استاذ ياسر ودائماً الى الامام بكل ماهو جديد ومميز واسمح لي ان اوضح لاخونا السائل الاستاذ محيي الدين عن اول ما جال بخاطري عن هذا الكود احيانا قد نحتاج الى عرض تقرير معين لحساب معين باكثر من متغير كالتاريخ او اسم من قام بتسجيل البيان او ... او ... الخ وهو امر سهل وبسيط ومتعارف عليه ولكن ماذا لو كان المطلوب هو تقرير معين لاكثر من حساب وبمتغيرات محددة ؟؟؟ وهنا تبرز فائدة الكود وللتوضيح اكثر لنفترض ان لدينا قاعدة حفظ بيانات ( عبارة عن قيود يومية ) ولنفترض انني اريد عمل تقرير لمجموعة حسابات منتقاة كل حسب كوده في دليل الحسابات وذلك خلال فترة معينة لنوعية القيود التي تحمل النوع PAYABLES وتم اختيار ارقام الحسابات عن طريق ليست بوكس MULTI SELECTION وتم وضع هذه الارقام في صفحة محددة بشكل عمودي ولتكن صفحة بمسمى مؤقت وبتنفيذ الكود بالشكل التالي نحصل على المطلوب اولا : عمل تقرير لآخر رقم حساب في صفحة مؤقت وادراجه في صفحة التقارير ثانياً : حذف آخر سطر من صفحة مؤقت ثم تكرار الكود بنفس الخطوات مع مراعاة لصق النتائج الجديدة في آخر سطر بصفحة التقارير حتى يتم حذف كل ماهو موجود في صفحة مؤقت وبذلك نكون قد حصلنا على تقرير لاكثر من حساب مختار وباكثر من متغير ارجو ان تكون الفكرة واضحة تحياتي للجميع

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

بسم الله ما شاء الله ولا حول ولا قوة الا بالله جازاكم الله خيرا أراك اليومين الأخيرين شعلة نشاط اللهم لا حسد ولكن غبطة حتى شوف :wink2: ألف مبروك على المشاركة 5000 عقبال المليون