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

تفضل أستاذ حمدي .. يا بختك بموضوعك هذا حل آخر بالكود مشابه لحل الأستاذ الكبير أبو تراب (مع إمكانية أن يكون المدى مطاطي أي غير ثابت Dynamic) Distinct Validation List Across Columns.rar

عسى ان ينال اعجابك هشام_عماد salim.rar

استاذى ومعلمى وحبيبى سليم بك حاصبيا ملك المعادلات بصراحه انا كنت مقرر انى اقف جنب الحيط واشوف العمالقه وهما يتصارعون فى مصارعه الاكسل الحره واتعلم منهم واستفيد طبعا وانا واقف بعيد ليجينى كود اروح فيها وانا مش مستغنى عن عمرى دا الكبير ياسر بقى مقتول هههههههه وعامل تعبان ولكن بعد دعوتك خجلت من نفسى وكان لازم البى الدعوه -( فقم للمعلم ووفه التبديلا كاد المعلم ان يكون رسولا) علشان خاطر عيونك حل لغز الجدول المتحرك بالاكواد وتم اضافه خيار لتحديد بداية تسلسل الجدول اتمنى ان يحوز اعجابك Sub ÌÏæá() ActiveSheet.Unprotect Password:="111" If [j2] = "" Or [k2] = "" Or [l2] = "" Then MsgBox "فضلا قم بتحديد عدد الصفوف والاعمده وبداية تسلسل الجدول": Exit Sub Application.ScreenUpdating = False Range("a3:zz100000").ClearContents [a3] = [l2] Lr = Range("j2").Value Ll = Range("K2").Value For i = 4 To Lr + 2 For o = 2 To Ll Cells(3, o).Value = "=RC[-1]+r2c10" Cells(i, 1).Value = "=R[-1]C+1" Cells(i, o).Value = "=R[-1]C+1" Next Next ActiveSheet.Protect Password:="111", DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub جدول متحرك.zip

السلام عليكم رداً على سؤال الاستاذ ابراهيم ابو ليلى وضع كلمة "Blank" حتى في الخلايا المدمجة blank with merge.rar

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

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

السلام عليكم ورحمة الله وبركاته هدفيه للعاملين بالكنترولات المدرسيه ...... _ سجلات اعمال الكنترول كامله ... _ توزيع الملاحظين اليا على اللجان .... مع تحياتى ....

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

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

السلام عليكم الشكر واصل للاخ ابو تراب............ حفظه الله وائراءا للموضوع ممكن استخدام هذا الكود التالي بدون تحديد اسماء للبوكس شيك ولا للخلايا تستدل بالخلايا بموضع الشيك بوكس Sub kh_UpdateBoxes() Dim tx As String On Error Resume Next With Sheet1.Shapes(Application.Caller) If .ControlFormat.Value = 1 Then tx = "*" Else tx = "" .TopLeftCell.Offset(1, 0).Value = tx End With On Error GoTo 0 End Sub المرفق 2010 تشيك بوكس.rar

الأخوة المحترمون بعد التحية لمن شاركنا حل الموضوع والتحية لكل الأعضاء لقد تم حل المشكلة بحفظ ملف إكسل 2013 بصيغة الملف 2003 وتم نقل الورقة والحمد لله

السلام عليكم بعد اذن الاستاذ ابو تراب جزاه الله خيرا هذا حل اخر لاثراء الموضوع وفقكم الله ورعاكم ++هشام_عماد.rar

وعليكم السلام هلا هشام جرب المرفق هشام_عماد.zip

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

في التقرير , قم بتحويل مربعات التسمية Labels الى مربعات نص Text Box ثم اكتب في خاصية مصدر البيانات لمربع النص معادلة مثل المعادلة التالية =DCount("id","TPstoudnt","[alsaf]=1 and [dyana]=1") المعادلة السابقة هي احضار عدد الطلاب للشرط : الصف الأول - الديانة مسلم و على نفس النمط أكمل بقية المعادلات مع اختيار قيم الشروط المختلفة

بعد إذن أخي أبو تراب هذا حل آخر لإثراء الموضوع Restricting Entry In Text Box.rar

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

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

السلام عليكم اكتب هذا الكود و يمكنك تغيير النطاق و الخلية المفتاح حسب ما فهمت من المشاركة لايسمح بالكتابة الا اذا كانت خلية محددة تساوي 30 Private Sub Worksheet_selectionChange(ByVal Target As Range) If [h1] = 30 Then If Not Intersect(Target, Range("a1:a10")) Is Nothing Then Range("B1").Select End If End If End Sub

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

مبلغ الـ 2000 كما فهمت من مشاركاتك يتم حساب 1250 * 15% فيكون الناتج = 187.5 ثم المتبقي 2000 - 1250 = 750 يتم ضربه في 20% .. فيكون التاتج 150 .ومجموع 187.5 + 150 = 337.5 يرجى مراجعة شرحك ................................أنا في غاية الأسف على سوء قهمي إذا كنت قد أسأت الفهم

تفضل أخي الحبيب إبراهيم أبو ليلة Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Address = [F6].Address Then If IsEmpty(Range("F6")) Then Cells(8, 4).Value = "" Cells(9, 4).Value = "" Cells(10, 4).Value = "" Else Cells(8, 4) = 1 Cells(9, 4) = 2 Cells(10, 4) = 3 End If End If End Sub

وعليكم السلام و رحمة الله و بركاته اخي الغالي عبدالباري بعد اذنك استخدمت الملف الذي ارفقت و اضفت اضافة بسيطة لتجنب ادخال حروف انجليزية في مربع النص العربي و العكس. اذا ارد احدكم اضافة لغات اخر كاللغة الفرنسية مثلا فيمكنكم مراجعة الرابط التالي: قائمة اللغات هنا تجد ارقام ال Unicode لكل حرف تغيير لغة الكتابة للوحة المفاتيح.zip

افضل شيء البحث والاستبدال بحيث تستبدل خط traditional arabic مثلاً بخط simplified arabic ------------ وممكن عن طريق تحديد النص ذي التنسيق المتشابه وذلك بعمل كليك يمين على الفقرة المطلوب تغييرها واختيار أنماط (إذا كنت منسق بطريقة الأنماط) ثم تختار تحديد النص ذي التنسيق المتشابه وتغير الخط

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

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

السلام عليكم و رحمة الله وبركاته تم عمل اللونين الأخضر و الأحمر تنسيق ش.rar

تسلم أخي الحبيب أحمد مرجان ..بارك الله فيك يلا يا أ . محمد عبد الصمد ، ولا يكون في نفسك حاجة ..عندك دالة معرفة ومعادلات (اختر أيهما شئت أو اخنرهما معاً ..) تبقلوا تحياتي

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

أخى الفاضل تم التعديل ... برجاء عدم حذف القيمة الموجودة في الخلية A1 نهائيا فهى التى تحتوى على اسم الملف تحياتى Invoice-Update.rar

أنا مش قلت مرة يغلق .. إنتو شكلكو غاوين هزار

وإليكم حل اللغز الخاص بالأخ سليم الجدول المتحرك (بيفكرني ببحر الرمال المتحرك) والحلول مجمعة في ملف واحد Movable Table Conditional Formatting.rar

هههههههههههههههه...اهو مساعدة وخلاص أ.سليم جديدة دى

المساعدة على ماذا

تفضل أخى ابا اسماعيل مرفق الملف بعد التعديل ... تحياتي Invoice.rar

هلا ماجد جرب المرفق 14.zip

هل تقصد هذا الشيء Course Attendance_Req salim.rar

اخى الفاضل أبا اسماعيل تم عمل المطلوب باضافة زر Backup اسفل الحذف .. بمجرد الضغط عليه يتم انشاء نسخة احتياطية من شيت الفاتورة باسم الزبون في المسار C:\ExcelBackup لايلزم ان تقوم بانشاء المجلد فاذا لم يكن موجودا الكود يقوم بانشائه بالنيابة عنك تحياتي Invoice.rar

فهمت يااستاذنا انت عاوز حل ازاى ولكن بعد اجابات اساتذة ال VBA والاكسيل اليك اجابة بالمعادلات خد هذه من العبد لله . وطبقها . ستاتى بالنتيجة ان شاء الله =ROWS(A:A)*COLUMNS(1:1) New ورقة عمل Microsoft Excel.rar

طريقة حلى .. طبعا بالأكواد حددت الشيت كامل وسميته وليكن data كنطاق واحد ودخلت محرر الأكواد وفي حدث Worksheet_Activate كتبت السطر ده Range("A1").ClearContents Range("A1") = Application.CountBlank(Range("data")) اعطانى الرقم 17179869184 في الخلية A1 >>> اعتقد انه صحيح ... اوفيس 2010 بس .. شكرا الى اللقاء في لغز آخر تحياتي

السلام عليكم الاخ الكريم / إسلام الشيمي بارك الله فيك اليك اخي محاولة مني وتعديل طفيف علي كود القدير / عبد الله المجرب علي ملف الموجود بالمشاركة رقم 4# والخاص باغلاق الملف بعد فتحة 5 مرات اليك تعديل يجعل الملف يفتح لعدد 5 مرات وبعد ذلك لا يفتح الا بعد طلب رقم سري وان كان الرقم غير صحيحا يعمل علي اغلاق الملف وان كان الرقم صحيحاً تم الدخول للملف الرقم السري هو : 12345 وطبعا يمكنك تغييره كما تريد وذلك بتغييره في الكود نفسه وانتظر ردك بالنتيجة ... جزاك الله خيرا اغلاق ملف بعد فتحه 5 مرات وفتحه بعد ذلك برقم سري.rar

السلام عليكم الاخ الكريم / الصّارم اعتقد ان التالي به طلبك تماماً ولكن عذرا للاطالة فالموضوع ليس موضوعي ولكنه للقدير العبقري الاستاذ القدير / جعفر طرباق .... جزاه الله خيرا بعنوان ((( كيف نجعل الملف ينتحر و يحدف نفسه من الجهاز تلقائيا ! )))) ولكني احببت ان انقله كما هو ليستفيد منه الجميع بكل طرقه واشكاله ============================================= الكود ادناه يفعل ذلك من داحل الملف نفسه و يمكن ربطه مثلا بالحدث Workbook_BeforeClose و مسح الملف تلقائيا و نهائيا و من دون اشعار المستخدم. SuicidalWorkbook.rar Option Explicit Private Const MSG_TITLE As String = "Deleting Current Workbook ..." Private Const MSG_TEXT As String = _ "You are about to permanently delete the current workbook located in :" Sub Kill_Myself() Dim lUserDecision As Long Dim sMsg As String On Error Resume Next sMsg = "Attention !" & vbNewLine & vbNewLine sMsg = sMsg & MSG_TEXT & vbNewLine sMsg = sMsg & "'" & ThisWorkbook.FullName & "'" & vbNewLine sMsg = sMsg & "from Disk!!" & vbNewLine & vbNewLine sMsg = sMsg & "Go ahead ?" & vbNewLine & vbNewLine Beep lUserDecision = _ MsgBox(sMsg, vbExclamation + vbYesNo, MSG_TITLE) With ThisWorkbook If lUserDecision = vbYes Then .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End If End With End Sub ====================================================== الكود التالي يحدف الملف بعد شهر واحد من اول استعماله تلقائيا و بدون اشعار المستخدم ! ضع الكود في ThisWorkbook Module Option Explicit Private Sub Workbook_Open() Dim lInitialDate As Long On Error Resume Next lInitialDate = Evaluate("InitialDate") If Err.Number = 13 Then Me.Names.Add "InitialDate", Date, False Me.Save End If If Date > Evaluate("InitialDate") + 30 Then Kill_Myself End Sub Private Sub Kill_Myself() .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End Sub ينصح اقفال الكود بباسوورد لمنع المستخدم من رؤية او حدف الكود. ================================================================ الكود التالي يحدف الملف بعد 3 الستعمالات تلقائيا و بدون اشعار المستخدم ! ضع الكود في ThisWorkbook Module Option Explicit Private Const MAX_USES As Long = 3 Private Sub Workbook_Open() Dim lNumberOfUses As Long On Error Resume Next lNumberOfUses = Evaluate("NumberOfUses") If Err.Number = 13 Then Me.Names.Add "NumberOfUses", 1, False Me.Save Exit Sub End If Me.Names.Add "NumberOfUses", Evaluate("NumberOfUses") + 1, False Me.Save If Evaluate("NumberOfUses") > MAX_USES Then Kill_Myself End Sub Private Sub Kill_Myself() With Me .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End Sub ينصح اقفال الكود بباسوورد لمنع المستخدم من رؤية او حدف الكود ========================================================= الكود التالي يحذف الملف بعد دقيقة واحدة من فتحه : (ضع الكود في ThisWorkbook Module) Option Explicit Private Const TIMEOUT As Long = 1 Private Sub Workbook_Open() Application.OnTime _ Now + TimeSerial(0, TIMEOUT, 0), Me.CodeName & ".Kill_Myself" End Sub Private Sub Kill_Myself() With Me .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End Sub ===================================================== حذف الملف ولكن باشعار المستخدم بذلك !!!! للتمكن من اشعار المستخدم و في نفس الوقت منعه تماما من اجهاض عملية حذف الملف , اقترح الكود التالي حيث يتم اشعار المستخدم بعد حذف الملف و ليس قبل : (الملف يحذف نفسه تلقائيا بعد 3 استعمالات و يشعر المستخدم بعد الحذف) Option Explicit Private Const MAX_USES As Long = 3 Private Sub Workbook_Open() Dim lNumberOfUses As Long On Error Resume Next lNumberOfUses = Evaluate("NumberOfUses") If Err.Number = 13 Then Me.Names.Add "NumberOfUses", 1, False Me.Save Exit Sub End If Me.Names.Add "NumberOfUses", Evaluate("NumberOfUses") + 1, False Me.Save If Evaluate("NumberOfUses") > MAX_USES Then Call NotifyUser Call Kill_Myself End If End Sub Private Sub NotifyUser() Dim sVbsFile As String sVbsFile = Environ("Temp") & "\VBS_MSG.vbs" Open sVbsFile For Output As #1 Print #1, "Dim Wb" Print #1, "On Error Resume Next" Print #1, _ "set wb=Getobject(" & Chr(34) & Me.FullName & Chr(34) & ")" Print #1, _ "MSG= ""You have exceeded the Maximum Number of uses of this file."" & vbnewline & vbnewline" Print #1, _ "MSG= msg & ""The file has been permanently deleted from your Drive !""" Print #1, "Do" Print #1, "Loop until wb.name=""""" Print #1, "WScript.Echo MSG" Close #1 Call Shell("WScript.exe " & sVbsFile) End Sub Private Sub Kill_Myself() With Me .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End Sub وارجو من الله ان يجعل فيها افادة ... وادعو للاستاذ القدير العملاق / جعفر ... جزاه الله خيرا جزاكم الله خيرا

السلام عليكم الاخ الكريم / الصّارم بعد اذن الاخوة الكرام اليك اخي ملف رااائع للقدير دائما / عبد الله المجرب الملف المرفق ملف يفتح لـ 5 مرات فقط ثم يغلق بعدها ارجو ان يلبي طلبك جزاك الله خيرا اغلاق ملف.rar

الأخوة الأعزاء برجاء المساعدة المطلوب توزيع عدد الملاحظين علي أيام الإمتحانات بالتساوي علما أن عدد اللجان 12 لجنة يوميا ولا يتكرر رقم اللجنة امام الملاحظ مرتين علي أن يكون عدد مرات العمل متساوية علما بأن الرقم يتكرر عموديا مرتين فقط من 1 : 12 كشف ملاحظة ثانوي.rar

و بارك فيك أخي بالنسبة لطلبك عندي جدول عملته قبل كدة بيطلع منه جداول مدرسين و جداول إشراف كمان بس 7 حصص في اليوم و جاري تعديله ليكون 8 حصص لكن لو عايزالجدول 7 حصص أنا تحت أمرك في أي وقت