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

السلام عليكم ورحمة الله وبركاته اعضاء منتدانا الكرام هذه محاولة لعمل رسالة تلميحية لخلية بالاكواد ارجوا ان تنال اعجابكم. اعلم انه يمكنك عملها عن طريق اضافة تعليق و لكن هذه محاول عبر الكود بحيث يظهر التلميح عند اختيار الخلية المناسبة. الفكرة هى وضع شكل Shape و تنسيقه و من ثم تسميته بما تشاء (اسميته هنا بـ CellTip) بعدها يمكنك التحكم به كما في الكود التالي: Private Sub Worksheet_SelectionChange(ByVal Target As Range) With ActiveSheet.Shapes("CellTip") If Not Intersect(Target, Range("B3:D12")) Is Nothing And Target.Count = 1 Then .Top = Target.Top + 20 .Left = Target.Left With .TextFrame2.TextRange.Characters Select Case Target.Column Case 2: .Text = "الاسم الأول متبوع بأسم العائلة" ' B = الاسم Case 3: .Text = "العمر بالسنوات" ' C = العمر Case 4: .Text = "عنوان الاقامة الحالي" ' D = العنوان End Select End With .Visible = True Else .Visible = False End If End With End Sub لمزيد من التوضيح انظر الملف المرفق. الحمد لله وحده الذي بنعمه تتم الصالحات Cell Tip.zip

السلام عليكم ورحمة الله وبركاته كثيرا ما كان يزعجنى في الفورم رسالة التنبيه الملحقة بخاصية ال Match Required الخاصة بالكمبو بوكس بالرغم من أهميتها الشديدة لإلزام المستخدم من الاختيار من القائمة .... ولكن عند الوقوف على الكمبو والضغط على زر خروج تظهر رسالة Invalid Property Value >>> وتستمر في الظهور الى ان اختار اى عنصر من الكمبو مرفق كود بسيط لاظهار رسالة خطأ اذا تم كتابة اى عنصر ليس موجودا بالكمبو .. أى بديل لخاصية ال Match Required ورسالتها المزعجة ... أدعوا الله ان يجازى صاحبه عنا خير الجزاء تحياتي Select-From-Combobox.rar

ماذا عن هذا Private Sub UserForm_Initialize() With Me .Width = Application.Width .Height = Application.Height End With End Sub

اخى الفاضل خد بعضك واضغط على الرابط ده افتح الباب وادخل لعالم البرمجة (متخافوش يا أحباب من اللي ورا الباب) المشاركة رقم 14 .... الحلقة العاشرة .... وانت هتعرف كل حاجة عن ال MsgBox تحياتي

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

الاستاذ محمد الريفي .. انت رائع الهمتني فكرة افضل و اكثر احترافية هذا الكود بأستخدام ال Data Validation If Not Intersect(Target, Range("H3:J12")) Is Nothing And Target.Count = 1 Then With Target.Validation .Delete Select Case Target.Column Case 8: .Add Type:=xlValidateInputOnly .InputTitle = "الأسم": .InputMessage = "الاسم الأول متبوع بأسم العائلة" Case 9: .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Formula1:="=And(mod(" & Target.Address & ",1)=0," & Target.Address & ">0)" .InputTitle = "العمر": .InputMessage = "العمر بالسنوات" .ErrorTitle = "الخطأ": .ErrorMessage = "العمر يجب ان يكون كبر من الصفر و بدون كسور" Case 10: .Add Type:=xlValidateInputOnly .InputTitle = "العنوان": .InputMessage = "عنوان الاقامة الحالي" End Select End With End If مرفق ملف لمن اراد تطبيق الطريقة سيتم اظهار رسالة خطأ اذا ادخل العمر بأقل من صفر او بكسور تقبل تحياتي Cell Tip and Data Validation.zip

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

برنامج شئون الموظفين يعمل بالتاريخين الهجرى والميلادى. امكانية البحث برقم الموظف . امكانية ربط الموظف بصورة الموظف من اى مكان من الحاسب (وليس وضع الصور بجانب الملف كما كان مسبقا). امكانية حذف موظف او تعديل بيانات الموظف . اصدار تقارير عن موظف واحد بطباعة بياناته فى صفحة مستقلة. امكانية تصدير التقارير لملف اكسيل جديد باسم جديد. البحث بين تاريخين . امكانية طباعة عدد من الموظفين سواء (اسم الموظف - الراتب - الاقامات - الادارة التابع لها - او اى بيانات مدخلة ). التحكم فى تغيير اسم الشركة . نافذة امان قبل الدخول للبرنامج بكلمة مرور يمكن اظهار النافذة او اغلقها. امكانية التحكم فى اعدادات المظهر (خلفية البرنامج - لون الخط ). للاطلاع عن المزيد من الصور والشرح للبرنامج من هنا او الاطلاع على دليل المستخدم من البرنامج شكر خاص للأستاذ/ عبد الله باقشير حيث استخدمت الكثير من اكواده الاكثر من رائعه وكذلك باقى الاعضاء الاخرين ملاحظة : باسورد نافذة الامان الافتراضى 12345 باسورد vba وقاعدة البيانات وفتح الملف 12345 لابد من تمكين الماكرو ليعمل الملف فى النهاية نسألكم الدعاء بظهر الغيب emp.rar

اريد ان اشارك بهذا المشروع الجميل والمفيد جدا بكود اهداني اياه اخ فاضل في هذا المنتدى مشكورا ارجو ان يستفيد به غيري وهو عبارة كود طباعة مرن ورائع Sub PrintSelectedSheets() ' Display "Printer Setup" dialog box Application.Dialogs(xlDialogPrinterSetup).Show ' Option Explicit ' Sub SelectSheets() 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 Application.ScreenUpdating = False ' Check for protected workbook If ActiveWorkbook.ProtectStructure Then MsgBox "Workbook is protected.", vbCritical Exit Sub End If ' Add a temporary dialog sheet Set CurrentSheet = ActiveSheet X = CurrentSheet.Name Set PrintDlg = ActiveWorkbook.DialogSheets.Add SheetCount = 0 ' Add the checkboxes TopPos = 40 For i = 1 To ActiveWorkbook.Worksheets.Count Set CurrentSheet = ActiveWorkbook.Worksheets(i) ' Skip empty sheets and hidden sheets 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 ' Move the OK and Cancel buttons PrintDlg.Buttons.Left = 240 ' Set dialog height, width, and caption With PrintDlg.DialogFrame .Height = Application.Max _ (68, PrintDlg.DialogFrame.Top + TopPos - 34) .Width = 230 .Caption = "Select sheets to print" End With ' Change tab order of OK and Cancel buttons ' so the 1st option button will have the focus PrintDlg.Buttons("Button 2").BringToFront PrintDlg.Buttons("Button 3").BringToFront ' Get the number of print copies for each report Numcop = Application.InputBox("Enter number of copies to print:", _ "How Many Copies?", 1, Type:=1) If Numcop = 0 Then ElseIf Len(Numcop) > 0 Then End If ' Display the dialog box CurrentSheet.Activate Dim cnt As Integer 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 ' Replace:=False 'Activate Else Worksheets(cb.Caption).Select Replace:=False 'Activate End If cnt = cnt + 1 End If Next cb ActiveWindow.SelectedSheets.PrintOut copies:=Numcop 'ActiveSheet.PrintPreview 'for debugging End If Else MsgBox "All worksheets are empty." End If ' Delete temporary dialog sheet (without a warning) Application.DisplayAlerts = False PrintDlg.Delete ' Reactivate original sheet Sheets(X).Select End Sub

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

الحمد لله انك وجدت الحل تحياتى

السلام عليكم المعادله المستخدمه =IFERROR(VLOOKUP(TRIM($B5);$A$64:$B$75;2;0);"") تم استخدام الداله VLOOKUP للبحث عن السعر TRIM B5 اسم الصنف A64:B75 الجدول المراد البحث فيه رقم 2 العمود تم استخدام الداله TRIM لحذف الفراغات تم استخدام الداله IFERROR لارجاع فراغات مكان الاخطاء فى حالة عدم وجود نتيجة البحث استبدال N/A بفراغات ارجو ان اكون قد وفقت فى التوضيح تحياتى اليك

ضع هذا الكود في الفورم Private Sub UserForm_Initialize() With Application .WindowState = xlMaximized Zoom = Int(.Width / Me.Width * 100) Width = .Width Height = .Height End With End Sub

رائع

إثراءً للموضوع هذا حل آخر بالأكواد Sub Test() Dim Cell As Range, Rng As Range On Error Resume Next Set Rng = Sheet1.Range("B2:E" & Sheet1.Cells(Rows.Count, 2).End(xlUp).Row) For Each Cell In Sheet2.Range("E2:E" & Sheet2.Cells(Rows.Count, 2).End(xlUp).Row) Cell.Value = Application.WorksheetFunction.VLookup(Cell.Offset(0, -3), Rng, 4, False) Next Cell End Sub

موضوع جميل و حرفي تمام شكرا أخي أبو تراب بارك الله بك

ابن مصر الغالى فعلاً هو المطلوب دائماً مبدع جزاك الله خيراً و زادك علماً

الاخوة الكرام اليوم بمشيئة الله سنكمل عملية الترحيل وهنعرف ازاى نمنع المستخدم من تكرار ترحيل سند القبض ففى المره الاولى عند الضغط على زر الترحيل تظهر رساله " تم الترحيل بنجاح " وفى المره الثانية عند الضغط على زر الترحيل تظهر رسالة " تم الحفظ مسبقا" وذلك يتم باستخدم الحلقه التكرارية For next والتى قمنا بشرحها على الرابط التالى http://www.officena.net/ib/index.php?showtopic=58471&hl= اود منكم مراجعه سربعه على المشاركة رقم 48 من الصفحه 3 بالموضوع سنجد اننا وقفنا بالشرح عند هذا الكود Sub ترحيل() Application.ScreenUpdating = False If [G7] = "" Or [d8] = "" Or [d10] = "" Or [d11] = "" Then MsgBox "الرجاء ادخال جميع بيانات السند": Exit Sub With Sheet4 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row If [G6] = "نقدى" Then .Cells(Lr + 1, "A") = [d8] .Cells(Lr + 1, "B") = [G7] .Cells(Lr + 1, "D") = [d10] .Cells(Lr + 1, "G") = [d11] .Cells(Lr + 1, "E") = "=R[-1]C+RC[2]-RC[ End If If [G6] = "شيك" Then .Cells(Lr + 1, "A") = [d8] .Cells(Lr + 1, "B") = [G7] .Cells(Lr + 1, "D") = [d10] .Cells(Lr + 1, "i") = [d11] .Cells(Lr + 1, "j") = "=R[-1]C+RC[-1]-RC[-2]" End If End With End Sub سنجد ان اول سطر بالكود وهو Application.ScreenUpdating = False وهو يعنى كما قلنا من قبل تثبيت حركة الشاشه عند عمل الكود **************************************************************************** السطر الثانى من الكود وهو If [G7] = "" Or [d8] = "" Or [d10] = "" Or [d11] = "" Then MsgBox "الرجاء ادخال جميع بيانات السند": Exit Sub وهو يعنى اجبار المستخدم على ادخال كل بيانات سند القبض فعند عمل الكود يقوم بالتشييك على الخلايا المذكورة لو وجد بها خلية فارغه سيتوقف الكود ويظهر رساله الرجاء ادخال جميع بيانات السند قم الخروج من الكود Exit Sub ***************************************************************************** ثم السطر التالى وهو With Sheet4 وهو يعنى انى انا بقول للكود الاسطر التالية سيكون موجهه الى Sheet4 وهى تعنى الورقه المراد الترحيل البيانات اليها *************************************************************************** السطر التالى من الكود هو Lr = .Cells(.Rows.Count, "D").End(xlUp).Row وهو يعنى تعريف اخر خليه بها بيانات بالعمود D وقمنا بتسميتها LR ويمكن التغيير الى اى حرف او احرف حسب مزاجك ********************************************************************************** بعد كدا الكود بيقوم باختبار الخلية [G6] لو هى نقدى بيقوم بترحيل البيانات حسب الاسطر العمود النقدية ثم اغلاق End if // ولو هى شيك بيقوم بترحيل الاسطر الى عمود الشيكات ثم اغلاق End if المطلوب هنا قبل عملية الاختبار اذا كان نقدى او شيك ان يقوم الكود باختبار هل رقم السند اللى موجودبالخلية [G7] موجود بالعمود B يعنى تم ترحيله مسبقا أم لا يعنى عايزين نعمل كود يقوم بالذهاب الى العمود B بدءاً من الخلية B5 وحتى اخر خلية فى العمود فيها ارقام مكتوبه لو وجد فى اى خليه رقم السند اللى موجود بالخلية [G 7] يظهر لى رساله بان السند تم حفظه مسبقا ويطلع من الكود ازاى نعمل الكلام دا بالبرمجه هيكون من خلال For next For i = 5 To Lr If .Cells(i, "B") = [G7] Then MsgBox "هذا السند تم حفظة مسبقا ": Exit Sub Next عملنا حلقه تكرارية من الصف 5 بالعمود ب الى اخر خلية فى العمود بها ارقام طيب الحلقه دى هتلف على الخليه تشوف وتختبر فيها ايه هتشوف الرقم اللى موجود بالخلية [G7] موجود باى خلية منهم او لا لذالك استخدمنا IF [If .Cells(i, "B") = [G7 لو الخلية وهى Cells ( اى خلية يتم قرائتها باسم العمود ورقم الصف مثلا نقول A4 تكتب هكذا ("Cells(4, "A / رقم 4 هنا هو الصف ورقم 1 هنا هو العمود A طيب فى المثال بنتاعنا معروف العمود وهو B وغير معروف الصف الصف متغيير بالحلقه التكرارية لذالك عملنا حلقه For i = 5 To Lr و i ترمز للصف لذالك كتبنا [If .Cells(i, "B") = [G7 لو حصل الشرط ده يظهر رساله "هذا السند تم حفظة مسبقا " ويخرج من الكود ب Exit Sub وطبعا For دائما تقفل ب next وهيكون الكود بشكله النهائى كالتالى Sub ترحيل() Application.ScreenUpdating = False If [G7] = "" Or [d8] = "" Or [d10] = "" Or [d11] = "" Then MsgBox "الرجاء ادخال جميع بيانات السند": Exit Sub With Sheet4 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row For i = 5 To Lr If .Cells(i, "B") = [G7] Then MsgBox "هذا السند تم حفظه مسبقا ": Exit Sub Next If [G6] = "نقدى" Then .Cells(Lr + 1, "A") = [d8] .Cells(Lr + 1, "B") = [G7] .Cells(Lr + 1, "D") = [d10] .Cells(Lr + 1, "G") = [d11] .Cells(Lr + 1, "E") = "=R[-1]C+RC[2]-RC[1]" MsgBox "تم عملية الترحيل بنجاح" End If If [G6] = "شيك" ThenIf [G6] = "شيك" Then .Cells(Lr + 1, "A") = [d8] .Cells(Lr + 1, "B") = [G7] .Cells(Lr + 1, "D") = [d10] .Cells(Lr + 1, "i") = [d11] .Cells(Lr + 1, "j") = "=R[-1]C+RC[-1]-RC[-2]" MsgBox "تم عملية الترحيل بنجاح" End If End With Application.ScreenUpdating = True End Sub ارحو ان اكون وفقت بالشرح ياريت تجربوا عملى حتى تتضح لكم الامور بشكل افضل تقبلوا تحياتى

السلام عليكم اتفضل اخى الكريم حساب الكرتات.rar

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

يامرحبا بأخي الغالي الجموعي .. سعد بمرورك العطر و جمال عباراتك تقبل تحياتي

اخي الفاضل / ابو تراب جزاك الله خيراً على المجهود الاكثر من رائع مشكور

السلام عليكم اليك اخى الكريم ماتريده ان شاء الله تقبل تحياتى 5.rar

اخى الكريم ياريت ترفق ملف بماتريده وان شاء الله تلاقى الكثير يساعدك عموما اعددت اليك ملف حسب مافهمت من طلبك New ورقة عمل Microsoft Excel.rar

الف مليون مبروك اخي العزيز عبدالرحمن واهنيك اولا علي روحك الجميلة المعطاءة

ماشاء الله أستاذي أبو تراب إبداع بلا حدود سلمت يمينك تحياتي

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

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

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

الف مبروك وادعوا لك بمزيد من العطاء

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

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

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

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

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

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

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