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

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

اخى الكريم استبدل السطرين الخاصين بالتكست بوكس 3 و 4 بهذين السطرين TextBox3.Value = Format([b9], "dddd") TextBox4.Value = Format([c9], "yyyy/mm/dd") تقبل تحياتى

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

على كل حال الشرح يكون كالتالي Sub استدعاء() ' في حالة الخطأ إستمر On Error Resume Next '----------------------------------- '************************************ '------------------------------------ ' اذا كانت الخلية بي4 فارغة و سي4 فارغة و أو4 فارغة ، إذا If [B4] = "" And [C4] = "" And [E4] = "" Then '------------------------------------- '************************************* '------------------------------------ ' اخرج مساج بوكس نصه هو التالي MsgBox "يجب اختيار حساب بدلالة رقم الحساب او اسم الحساب او اختار رقم فيد", vbInformation + vbMsgBoxRight, "تنبيه" '----------------------------------- '*********************************** '---------------------------------- ' و إلا Else '---------------------------------- '*********************************** '---------------------------------- ' إمسح النطاق : ـ [B9:H200].ClearContents '---------------------------------- '********************************** '----------------------------------- ' الخلية بي 6 تساوي فراغ مضاف اليه الخلية كا 1 ( مضاف لا تعني علامة + و غنما توضع بجانبها [B6] = "" & [K1] '----------------------------------- '********************************** '---------------------------------- 'امنع اهتزاز الشاشة Application.ScreenUpdating = False '---------------------------------- '********************************** '---------------------------------- 'حلقة تكرار تبدأ من 1 الى عدد صفحات العمل For x = 1 To Sheets.Count '----------------------------------- '********************************** ' اسناد الصفحة الحالية الى رقم المتغير إكس MySheets = Sheets(x).Name '--------------------------------- '********************************* '--------------------------------- ' إذا كان اسم الصفحة هو : قيود اخرج من الحلقة التكرارية If Sheets(x).Name = "القيود" Then Exit For '----------------------------------- '*********************************** '----------------------------------- ' حلقة اخرى بدايتها الصف الثالث و نهايتها آخر شيئ مكتوب في العمود أ For R = 3 To Sheets(MySheets).[A1500].End(xlUp).Row '--------------------------------- '********************************* '--------------------------------- ' اذا كانت الخلية حسب قيمة المتغير آر في العمود الرابع تساوي الخلية بي 4 ( نفس الشيئ بالنسبة لبقية السطر مع بعض التغييرات ) ـ If (Sheets(MySheets).Cells(R, 4) = [B4] Or Sheets(MySheets).Cells(R, 6) = [C4] Or Sheets(MySheets).Cells(R, 1) = [E4]) And (Sheets(MySheets).Cells(R, 7) >= [G4] And Sheets(MySheets).Cells(R, 7) <= [H4]) Then '-------------------------------- '********************************** '--------------------------------- ' انظر الى آخر خلية فارغة في العمود بي من ورقة القيود With Sheets("القيود").[B200].End(xlUp) '------------------------------- '******************************** '--------------------------------- ' امشي بصف واحد من أخر خلية في العمود بي وأكتب فيها ما هو موجود في الخلية مصدر البحث الموجودة في العمود الاول الصف آر .Offset(1, 0) = Sheets(MySheets).Cells(R, 1) ' بقية الاسطر نفس الشي باختلاف الموقع فقط '--------------------------------- '********************************* '--------------------------------- 'انتهى اسناد الصفحة End With '---------------------------------- '********************************* '-------------------------------- 'انتهى الشرط End If '--------------------------------- '********************************* '--------------------------------- ' اكمل ححتى آخر عدد Next R '-------------------------------- '********************************* '--------------------------------- Next x '----------------------------------- '************************************ '------------------------------------ ' ارجع الشاشة لحالتها الاصلية Application.ScreenUpdating = True '--------------------------------- '********************************* '---------------------------------- 'اظهر مساج بوكس ينص على التالي MsgBox "!تم استخراج الكشف المطلوب بنجاح", vbInformation + vbMsgBoxRight, "تم الاستخراج" '-------------------------------- '********************************* '--------------------------------- ' امسح النطاق التالي [B4:E4].ClearContents '********************************** '---------------------------------- 'انتهى الشرط الثاني End If

السلام عليكم أخي ياسر العربي جزاكم الله خيرا على المرور و انعم عليكم بالصحة و الهناء سعدت كثيرا حينما رأيت بصمتكم هنا أخي وائل يونس ياراجل . . . . إنت بس إضمنلي أكلة وحدة من القائمة المنسدلة للاطعمة التي ذكرتها و رمشة عين تلاقيني في مطار دمشق ( في الطيارة طوالي ) و يا عيني على المشوي و ما جاوره و راح اطبق عليها الكود التالي : IF المشوي و الكباب في سوريا then راح اطير إليها طوالي Else ارجع لبيتي مكسور الخاطر End if أخي وائل : و الله لقد سعت كثيرا لمرحك و طيبة قلبك ، جزاكم الله خيرا

السلام عليكم أخي العزيز هناك حلين الأول يمكن وضع السطر التالي بعد الانتهاء من عملية اللصق <Application.CutCopyMode = False> او استخدم النسخ واللصق بدون استخدام الذاكرة بمعنى استخدام الـ (clipboard) كما التالي Range("A1:I1105").Copy Sheets("Sheet2").Range("B2")

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

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

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

بسم الله و ما شاء الله اللَّهُمَّ انْفَعْنَا بِمَا عَلَّمْتَنَا , وَعَلِّمْنَا مَا يَنْفَعُنَا , وَزِدْنَا عِلْمًا إِلَى عِلْمِنَا اهداء لكل من شارك بعلمه اقل ما يقال لكم "عندما تنتهى كلمات الابداع عندكم و تبدأ من جديد و تنتهى عندكم" بارك الله لكم مدونة اعمال ايقونات الماس لمنتدى اوفيسنا _ شارك بتعديلاتك فكرة المدونة هى سهولة الوصول و البحث فى المنتدى 1 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_برامج جاهزه ( حسابات_ميزان مراجعه_سندات قبض_يوميه) 2 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_بحث_اضافة_تعديل_ترحيل_ادخال 3 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_اكواد و معادلات و فورم 4 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_شاشة دخول_صلاحيات_PASS WORD 5 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_الاتصالات_الادارية_الموظفين 6 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_كنترول_امتحانات_لجان 7 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_الاكسيل الترفيهي 8 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_الاكسيل الاسلامى و لا تنسونا من صالح الدعاء و لامى بالمغفره و الرحمه

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

السلام عليكم كلما تمت التجربة كلما قلت الاخطاء بالفعل لم اضع الاجمالي في آخر صفحة الطباعة امسح الموديل 2 و انسخ مكانه الكود التالي Sub iPageSetup() Application.ScreenUpdating = False Dim sh As Worksheet, Lr As Integer, Last As Integer Set sh = Sheets("sPrint") With sh Last = .Range("A" & Rows.Count).End(xlUp).Row + 1 .PageSetup.PrintArea = "" .Range("A8:E" & Last).Borders.Value = 0 '----------------------------------------------------- .Range("A8:E" & Last).ClearContents '------------------------------------------------------- .PageSetup.LeftMargin = Application.InchesToPoints(0.5) .PageSetup.RightMargin = Application.InchesToPoints(0.5) .PageSetup.TopMargin = Application.InchesToPoints(0.5) .PageSetup.BottomMargin = Application.InchesToPoints(0.5) .Columns("A:A").ColumnWidth = 8: .Columns("B:B").ColumnWidth = 18 .Columns("C:C").ColumnWidth = 25: .Columns("D:D").ColumnWidth = 14 .Columns("E:E").ColumnWidth = 15: .Cells.Font.Size = 12 End With sh.Range("A8").Resize(UserForm2.ListBox1.ListCount, 5).Value = UserForm2.ListBox1.List Lr = sh.Range("A" & Rows.Count).End(xlUp).Row sh.Range("A8:E" & Lr).Borders.Value = 1 sh.Range("C" & Lr + 2) = "المجمــوع :" sh.Range("D" & Lr + 2) = UserForm2.T_Total.Value sh.Range("C" & Lr + 2 & ":D" & Lr + 2).Borders.Value = 1 sh.PageSetup.PrintArea = "A1:E" & Lr + 3 Application.ScreenUpdating = True sh.PrintOut End Sub

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

غير مصدر الحقل الي تحتاجه ( في التقرير ) من الى

و عليكم السلام و رحمة الله و بركاته ... ارجو التوضيح اكثر مع ارفاق مثال للتعديل عليه ...

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

السلام عليكم اخي الكريم انا الان لا زلت اعمل على برنامج يكون فيه لغتين العربية والتركية المرحلة التي وصلت لها هي : 1- أنشأت جدول وضعت فيه رسائل التحذير باللغتين حتى استخدمها في msgbox 2 - أنشأت جدول وضعت فيه المسميات للأزرار ومربعات النص 3- طبعا وفي جدول الخيارات يكون فيه خيار تحديد اللغة 4 - أنشأت وحدات نمطية لتسهيل الاتصال بجداول المذكورة سابقا واخيرا ما زال العمل قائم على المشروع والتحدي الأكبر سيكون عندما يعمل البرنامج على كل الاجهزة مع اختلاف الاعداد الاقليمية بين الأجهزة

انا اسف اخي واستاذي الفاضل عبدالله لم انتبه الي اجابتك انت فعلا ارسلت نفس الحل بالظبط ولاكنك لم تشرح لي ماذا فعلت كما فعل الاخ ابو خليل انت وضعت فلتر تصاعدي في استعلام sersh_opshen ونفس الطريقه الاخ ابو خليل بس هذا الاستعلا ليس هو الاستعلام المرتبط بنموذج form8 الذي اريد ان يظهر به سعر الحبه في الاول انما الاستعلام المقصود هو sersh_parcode وهو مصدر النموذج form8 فطبعا الاخ ابو خليل لما شرح الفكره وصلت لي الفكره وجعلت الفلتره في استعلام sersh_parcode تصاعدي فظبط الامر فكل ما اقصده ان الشرح يسهل الامر ولك كل الشكر والتقدير وانا اسف اني لم انتبه الي اجابتك

الكود الذي ستجد به بارامتر أي كلام بين القوسين لا شأن لك به فهو إجراء يشبه الدوال المعرفة وعلى أساسه يعمل الإجراء الفرعي الآخر فالكود المسمى DoIt هو الكود الذي ستقوم باستدعائه

كود رائع استاذ ياسر .. سلمت يمينك

أستاذ / ياسر نعم هو المطلوب حزاكم الله خيرا

هذا ما كنت اقصده

Private Sub TextBox1_Change() On Error Resume Next Label1.Visible = True Label2.Visible = True Label3.Visible = True Label4.Visible = True Label5.Visible = True Label6.Visible = True ListBox1.Visible = True '======================================= Dim ws As Worksheet Dim V As Integer Dim LastRow As Integer Dim M As String Dim Q, F ListBox1.Clear If TextBox1.Text = "" Then GoTo 1 M = TextBox1.Text Set ws = Sheets("Sheet1") With ws LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row Set Q = .Range("A2:A" & LastRow).Find(M) If Not Q Is Nothing Then F = Q.Address Do If Application.WorksheetFunction.Search(M, Q, 0) = 1 Then If Q.Offset(, 1) = TextBox8.Text Then ListBox1.AddItem Q.Value ListBox1.List(V, 1) = Q.Offset(0, 1).Value ListBox1.List(V, 2) = Q.Offset(0, 2).Value ListBox1.List(V, 3) = Q.Offset(0, 3).Value ListBox1.List(V, 4) = Q.Offset(0, 4).Value V = V + 1 End If: End If Set Q = .Range("A2:A" & LastRow).FindNext(Q) Loop While Not Q Is Nothing And Q.Address <> F End If End With 1 End Sub اخي انس جرب الكود التالي في الملف الذي نشرته في مشاركتك الاخيرة لم اقم باي تغيير سوى إشرك مربع النص رقم 8 في البحث

و عليكم السلام ورحمة الله و بركاته ... تستطيع عمل حقل في الاستعلام ... فمثلا الحقل الذي تريده اسمه " aadd " تعمل حقل جديد كما يلي aadd2: iif(isnull[aadd];"لا يوجد";[aadd])

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

السلام عليكم فعلاً الصقر صقر بارك الله بك

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

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

استعمل هذه المعادلة في الخلية BA4 و اسجب نزولاً (لا تنسَ استعمال Ctrl+Shift+Enter)لانها معادلة صفيف =IF(ROWS($BA$4:BA4)>COLUMNS(Loading),"",SMALL(TRANSPOSE(COLUMN(Loading)),ROWS($BA$4:BA4))) انا لم اقم الا بالاجابة على السؤال المطروح : وهو بيانات فريدة مرتبة تنازلياً

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

اهلا بكى اخى عبدالعزيز اشتقت اليكم جميعا اخى الحبيب والرائع هو صحبتكم الجميله اخى الغالى جزاك الله كل خير ونتمنى ان نتعلم منكم اكثر واكثر وزادكم الله من فضله وعلمه تقبل تحياتى ياغالى

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

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

هل هناك تنسيق شرطي في ورقة العمل؟ جرب أن تضيف السطر التالي Ws.Rows(sRow + 1 & ":" & lngRow).Clear قبل هذا السطر Ws.Rows(sRow + 1 & ":" & lngRow).Delete

عندي ربع ساعة و انا احضر في السلطة دي ، أطلعها و لا أوضعها في الثلاجة ؟

الله المستعان جزاك الله خيرا ان اهديت لي عيوبي وجعلتني على بصيرة من امري اعتذر لجميع الاخوة ممن تصديت للاجابة على اسئلتهم طيلة اقامتي في هذا المنتدى ان كنت قد آذيتهم في انفسهم ويعلم الله ان هذا طبعي لا اتكلف ولا اتصنع واسأل الله الكريم ان يغفر لي ولك