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

بسم الله الرحمن الرحيم الاخوه الكرام اليوم بمشيئة الله سنتكلم عن المحور الخامس والاخير كيفية عمل تنسيقات للقيم المدخله فى TextBox عرفنا قبل كدا فى الشروحات السابقه ما هى اوقات تنفيذ الكود هنعمل مراجعه بسيطه لربط شرح اليوم بالشروحات السابقه قبل أن نتحدث عن وقت تنفيذ الكود لازم نعرف أولا أزاى بيكون كتابة ألاعلان عن الكود للـ TextBox Private Sub TextBox1_AfterUpdate() هنا يتم كتابة الكود المراد تنفيذه End Sub السطر الاول هو بداية الاعلان عن الكود فنقوم بكتابة Private Sub ستجد لونها بالكود أزرق ( وهو بداية لاى كود خاص لأى عنصر تحكم داخل الفورم ) ثم نقوم بكتابة اسم العنصر المراد عمل الكود له وهو بمثالنا TextBox1 ثم نقوم بكتابة _ ( تكتب من خلال الضغط على Shift+زر الطرح الموجود بالاعلى بجوار زر + ) ثم نقوم بكتابة وقت تنفيذ الكود (هو هنا على سبيل المثال AfterUpdate ) ثم كتابة () قوسين بهذا الشكل وبمجرد الضغط انتر ستجد الكود عمل سطر تانى فيه End sub يوجد طريقه اخرى وهى اتبع الصوره التالية توضح لك قم بالضغط على اى مكان فاضى بالفورم وادخل لمحرر الاكواد الخاص بالفورم هنبدأ بالامثله العمليه لان بالمثال يتضح لنا المقال وانا راجل عملى مش بحب النظرى 1-التحكم فى تنسيق القيم المدخله فى التكست بوكس بعدد صحيح شاهد الكود Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0") End Sub السطر الاول عرفنا انه الاعلان عن الكود وسوف يتم تنفيذه فى وقت تحديث التكست بوكس أى بعد الانتهاء من الادخال والانتقال او الخروج من التكست الى اى عنصر اخر على الفورم والسطر التانى هو الكود اللى هيتم تنفيذه شرح الكود ( السطر التانى ) شاهد الصوره هنا نوع التنسيق "0" تم وضعه بين علامتين تنصيص وبداخله 0 يعنى تنسيق التكست بوكس بعد الادخال يكون رقم صحيح فلو فرضنا حضرتك كتبت 20.60 وخرجت من التكست بوكس ستجد القيمة اصبحت 20 فقط ولا يوجد علامه عشريه -------------------------------------------------------------------------------------------------------------------------------------------------------- 2-التحكم فى تنسيق القيم المدخله فى التكست بوكس بوضع علامه عشريه Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0.0") End Sub هنا نوع التنسيق "0.0" يكون رقم واحد بعد العلامه العشريه مثال لو حضرتك ادخلت 20 فقط ستجد التكست بوكس اصبح 20.0 ولو حضرتك دخلت 20.2 ستجد التكست بوكس اصبح 20.2 ولو حضرتك دخلت 20.50 ستجد التكست بوكس اصبح 20.5 فقط يعنى سوا دخلت رقم عشري واحد او ادخلت رقمين عشريين او لم تدخل ارقام عشريه ستجد النتيجة بعد رقم عشرى واحد طيب لو احنا عايزين رقمين بعد العلامه العشريه الموضوع بسيط جدا هنخلى التنسيق كالتالى "0.00" شاهد الكود Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0.00") End Sub لاحظتم الفرق طيب لو 3 أرقام عشريه Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0.000") End Sub ------------------------------------------------------------------------------------------------------------------------------------ 3-التحكم فى تنسيق القيم المدخله بوضع علامه العمله $ Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0" & "$") End Sub هنا تم "0" ( وهو تنسيق رقم صحيح) ثم علامه & ( تكتب من خلال الضغط على Shift+رقم 7 فوق الحروف ) ثم ثم وضع علامه العمله "$" بين اقواس تنصيص فلو حضرتك كتبت 20 ستجد $20 واحد هيقولى هو مش ممكن يكون العلامه يسار الرقم وليس يمين الرقم هقوله ممكن وليه لا هنعكس الموضوع بدل "$"&"0" هنخليها "0"&"$" Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "$" & "0") End Sub فلو حضرتك كتبت 20 ستجد النتيجة 20$ طيب ممكن نخلى علامه العمله وكمان وجود ارقام عشريه طبعا ممكن Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "$" & "0.00") End Sub فلو حضرتك كتبت 20.1 ستجد النتيجة 20.10$ ---------------------------------------------------------------------------------------------------------- 4-التحكم فى تنسيق القيم المدخله بوضع نص بجوار الرقم Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0" & "ريال") End Sub هنا تم كتابه النص بين علامتى تنصيص " ريال" فلو حضرتك كتبت 20 ستجد النتجية 20 ريال -------------------------------------------------------------------------------------------------------------------- 5-التحكم فى تنسيق القيم المدخله بوضع علامه % Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "%0") End Sub فلو حضرتك كتبت 20 ستجد النتيجة %20 ( اذا كانت لغة الكتابه بالكيبورد عربى ) أما اذا كانت لغة الكتابة انجليزى وكتبت رقم 20 ستجد النتيجة 20% فمن خلال لغة الكتابه بالكيبورد تقدر تتحكم فى مكان العلامه % هل تكون قبل الرقم أم بعده واحد هيقولى هو ممكن نجعل الرقم بعلامات عشريه مع وجود علامه % هقوله ليه بس الاحراج يا عبدالتواب شوف يا سيدى الكود التالى Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "%0.00") End Sub فلو حضرتك كتب 20.1 ستجد النتيجة 20.10% ---------------------------------------------------------------------------------------------------------------------------------------- 6-التحكم فى القيم المدخله اذا كانت سالبه توضع بين اقواس Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0;(0)") End Sub فلو حضرتك كتبت -50 ستجد النتجية (50) يعنى تحول اى رقم سالب الى بين اقواس طيب لو كان الرقم السالب فيه علامات عشريه شاهد الكود ولاحظ الفرق البسيط Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0;(0.00)") End Sub مثال لو حضرتك كتبت-20.1 ستجد النتيجة (20.10) -------------------------------------------------------------------------------------------------------------------- 7-التحكم فى القيم المدخله اذا كانت تاريخ لو حضرتك عايز تكتب تاريخ وليكن 2015/8/6 وعايز بعد الادخال يظهر فقط اليوم Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "dd") End Sub ستجد ان النتيجه 6 dd تشير الى Day يعنى اليوم **************************************************************************** لو انا عايز النتيجة 6 اللى هى اليوم تظهر فى التكست بوكس 2 ( TextBox2) Private Sub TextBox1_AfterUpdate() TextBox2.Text = Format(TextBox1.Text, "dd") End Sub فلو حضرتك كتبت التاريخ 2015/8/6 فى التكست بوكس 1 ستجد التكست بوكس 2 مكتوب فيه 6 ************************************************************************************************ لو عايزين نظهر الشهر فقط هنستبدل dd بـ mm وهى اختصار لكلمة (Month) Private Sub TextBox1_AfterUpdate() TextBox2.Text = Format(TextBox1.Text, "mm") End Sub ستجد النتجية ظاهره فى التكست بوكس 2 وهى 8 ************************************************************************************** لو عايزين نظهر السنه. هنستبدل mm بـ yyyy وهى اختصار Year Private Sub TextBox1_AfterUpdate() TextBox2.Text = Format(TextBox1.Text, "yyyy") End Sub ستجد النتيجة فى التكست بوكس 2 هى 2015 ***************************************************************************************** لو عايزين نظهر اليوم كتابه 06-08-2015 يطلع فقط الخميس Private Sub TextBox1_AfterUpdate() TextBox2.Text = Format(TextBox1.Text, "dddd") End Sub ستجد النتيجة فى التكست بوكس 2 هى الخميس ********************************************************************************** لو عايزين نظهر الشهر 06-08-2015 يظهر فقط اغسطس Private Sub TextBox1_AfterUpdate() TextBox2.Text = Format(TextBox1.Text, "mmmm") End Sub ستجد النتيجة هى اغسطس ********************************************************************** لو عايزين ننسق التاريخ المدخل يكون كالتالى 06/08/2015 Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "dd/mm/yyyy") End Sub ****************************************** لو عايزين ننسق التاريخ المدخل يكون كالتالى2015/08/06 شوف الكود Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "yyyy/mm/dd") End Sub ****************************************** لو عايزين ننسق التاريخ المدخل يكون كالتالى06-08-2015 يعنى يكون العلامه بدل من / تكون - Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "yyyy-mm-dd") End Sub ****************************************** لو عايزين نجعل التاريخ كالتالى 06-08-15 ( يعنى أظهار السنه رقمين فقط Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "yy-mm-dd") End Sub هنا خلينا السنه بدل من yyyy الى yy فقط ****************************************** لو عايزين ننسق التاريخ كدا 06 أغسطس2015 Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "dd mmmm yyyy") End Sub ****************************************** لو عايزين نخلى التاريخ يظهر كالتالى الخميس أغسطس 2015 Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "dddd mmmm yyyy") End Sub ****************************************** لوعايزين نظهر تاريخ اليوم بمجرد وضع مؤشر الماوس فى التكست بوكس Private Sub TextBox1_Enter() TextBox1.Text = Format(Now, "yyyy/mm/dd") End Sub هنا استخدمنا وقت التنفيذ الحدث Enter ****************************************** 8-التحكم فى أجبار المستخدم على ادخال ارقام فقط فى التكست بوكس Private Sub TextBox1_Change() If Not IsNumeric(Me.TextBox1.Value) Then: MsgBox " الرجاء ادخال أرقام فقط ", vbCritical, "خطأ": Me.TextBox1.Value = "": Exit Sub End Sub هنا عملنا كود فى حدث التغيير للتكست بوكس بمجرد كتابة اى حرف وليس رقم ستجد التكست بوكس يرفض الادخال ويقوم بمسح المحتوى اللى تم ادخاله وكمان يظهر رساله استخدمنا فى الكود IF Not IsNumeric ثم التكست المراد ادخال ارقام فقط ووضعه بين قوسين ثم اقفال IF بـ then ****************************************** 9-التحكم فى أجبار المستخدم على ادخال حروف فقط فى التكست بوكس نفس الكود السابق ولكن بدون Not Private Sub TextBox1_Change() If IsNumeric(Me.TextBox1.Value) Then: MsgBox " الرجاء ادخال حروف فقط ", vbCritical, "خطأ": Me.TextBox1.Value = "": Exit Sub End Sub ****************************************** **************************************************************************** ******************************************************** ************************************** الى هنا بحمد الله انتهيت من شرح الخمس محاور المتعلقه بالتكست بوكس والى لقاء اخر من حلقات علمنى كيف اصطاد وسيكون بأذن الله الكمبوبوكس

السلام عليكم أخي الكريم إجعلها بصيغة الصفيف {} عن طريق أن تضغط (بعد الانتهاء من كتابة المعادلة في الخلية) ، تضغط Ctrl-Shift-Enter بدلا من Enter وحدها ستكون الصيغة كالتالي =LARGE($C$14:$C$36,{1;2;3;4;5}) مرفق الملف معدلا اكبر خمس قيم.rar

أساتذتى واخوانى الأعزاء السلام عليكم ورحمة الله وبركاته اليوم أقدم لكم كودا تستطيع من خلاله أن تعرض على المستخدم رسالة Message box ثم تختفى الـ Message box بعد تعامل المستخدم مع أزرار ها فاذا لم يتدخل تختفى الـ Message box تلقائيا بعد مدة زمنية محددة الكود وعليه شرح بسيط : Sub MokhtarTest() Dim Title As String Dim Delay As Byte Dim iType As Integer Dim Msg As String Dim MyObject As Object ' عنوان الرساله Title = " منتدى أوفيسنا" Delay = 2 ' مدة عرض الرساله بالثانية iType = 0 ' نوع الرسالة يساوى عدد مما يأتى ' من 128 الى 134' من 64 الى 70 ' من 32 الى 38 ' من 16 الى 22 ' من صفر الى 6 Msg = Space(10) & "مرحبا" & vbLf & vbLf & " تاريخ اليوم " & vbLf & vbLf & Date ' حجم ونص الرسالة Set MyObject = CreateObject("WScript.Shell") MyObject.Popup Msg, Delay, Title, iType Set MyObject = Nothing ' تفريغ الذاكرة End Sub تفضلوا المرفق والسلام عليكم displays a timed Message box then hide without click buttons .rar

جرب هده الفروميلة =INDEX(A1:A20,MATCH(MIN(COUNTIF(A1:A20,A1:A20)),COUNTIF(A1:A20,A1:A20),0)) هده Array Formula فيجب ادخالها في الخلية عن طريق Shift+Control+ Enter

السلام عليكم يا أستادي الفاضل مختار حسين فعلا نحن كلنا هنا لنتعلم و لهدا نحاول دائما تحسين أعمالنا قدر الامكان ... أنا أعتبر كل سؤال أو مشاركة فرصة للتعلم و لتحسين خبراتنا اليك هدا التعديل للكود فهو يتحسب مسبقا لأي أخطاء ممكن أن تحدث كما أنه أسرع و أكثر مرونة بسبب ال Enum Argument ممكن اضافة ميزة أخرى للكود ألا و هي اعطاء المستخدم امكانية ارجاع الخلايا كما كانت قبل التفريغ أو التعديل أو التلوين ملف للتحميل : https://app.box.com/s/3tmxv0k3xxzj3fg6616oounfugns55si الكود في موديول عادي: Option Explicit Private Enum ActionToTake EditCells = 0 EmptyCells = 1 ColorCells = 2 FlashCells = 4 End Enum Private Declare Function sndPlaySound32 Lib "winmm.dll" _ Alias "sndPlaySoundA" (ByVal lpszSoundName _ As String, ByVal uFlags As Long) As Long Sub test() Dim eAction As ActionToTake Dim sAction As String Dim oTargetRange As Range Set oTargetRange = Sheet1.Range("A1:K20") eAction = FlashCells Select Case eAction Case EditCells sAction = "edit" Case EmptyCells sAction = "clear" Case ColorCells sAction = "change the color of" Case FlashCells sAction = "flash" End Select If MsgBox("You are about to " & sAction & " the cells in the Range : " & vbCr & vbCr & _ oTargetRange.Address(external:=True) & vbCr & vbCr & "Go ahead ?", vbExclamation + vbYesNo) = vbYes Then If CheckRangeForErrors(Target:=oTargetRange, WhichAction:=eAction) = False Then MsgBox Err.Description End If End If End Sub Private Function CheckRangeForErrors( _ ByVal Target As Range, _ Optional ByVal WhichAction As ActionToTake = FlashCells _ ) _ As Boolean Dim oCellsWithErrorFormulae As Range Dim oCell As Range Dim ar() As Long Dim j As Long Dim i As Long Dim t As Single On Error Resume Next Set oCellsWithErrorFormulae = Target.SpecialCells(xlCellTypeFormulas, 16) If Not oCellsWithErrorFormulae Is Nothing Then With oCellsWithErrorFormulae Select Case WhichAction Case EditCells .Value = "Error Edited" Case EmptyCells .ClearContents Case ColorCells .Interior.Color = vbRed Case FlashCells ReDim ar(1 To .Cells.Count) For Each oCell In .Cells i = i + 1 ar(i) = oCell.Interior.ColorIndex Next oCell For i = 1 To 4 Call sndPlaySound32("C:\windows\media\notify.wav", 1) .Cells.Interior.ColorIndex = 3 t = Timer Do DoEvents Loop Until Timer - t >= 0.2 j = 0 For Each oCell In .Cells j = j + 1 oCell.Interior.ColorIndex = ar(j) Next oCell t = Timer Do DoEvents Loop Until Timer - t >= 0.2 Next i i = 0 For Each oCell In .Cells i = i + 1 oCell.Interior.ColorIndex = ar(i) Next oCell Erase ar Set oCellsWithErrorFormulae = Nothing Set oCell = Nothing End Select End With CheckRangeForErrors = True End If End Function

حفظك الله استاذي عبدالعزيز ما هو الا تطبيق لما تعلمناه في هذا المنتدى الرائع و أتمنى ان تفي بالغرض.

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

اخي حسام تفحص المرفق الكهرباء.rar

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

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

الافضل استخدام pivot table واظهار اعلى قيم كما تريد اكبر خمس قيم.rar

(جرب هذا الملف (صفحة 2 test salim.zip

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

السلام عليكم اريد ايجاد اكبر خمس قيم في الملف استخدم الدالة =MAX($C$14:$C$36;{1;2;3;4;5}) كذالك الدالة =LARGE($C$14:$C$36;{1;2;3;4;5}) اصبحة النتيجة اكبر خمس قيم.rar

لو سمحت انا عايز اعرف الدالة المستخدمة ف هذه الحالة ..حساب قيمة الاستهلاك مع العلم ان فارق القراءة معلوم والشروط هى 5 ريال لل 70 وات الاولى .. 9 ريال لل 80 وات التالية..15 ريال لل 200 وات التالية و 17 ريال لما زاد عن ذلك اخوكم ما زال يدرس المحاسبة الرجاء ساعدونى :)

السلام عليكم ورحمة الله وبركاته وبعد ,,, أقدم لكم اخوتى الأفاضل كودا يقوم بفحص نطاق من الخلايا ويحدد فقط الخلايا التى تحوى معادلات ذات القيم الخاطئة ويميزها بالتلوين أو التعديل أو التفريغ أو بعمل فلاش لتلك الخلايا لك الخيار فى اختيار شكل التمييز المناسب الكود وعليه شرح بعض السطور : Option Explicit Private Declare Function sndPlaySound32 Lib "winmm.dll" _ Alias "sndPlaySoundA" (ByVal lpszSoundName _ As String, ByVal uFlags As Long) As Long Sub CheckRangeForError() ' by mokhtat 2/10/2015 ' Error values include #DIV/0!, #N/A, #NAME?, #NULL!, #NUM!, #REF!, and #VALUE!. Dim C As Range Dim i As Integer Dim PlaySound As Boolean ' تحديد نطاق الفحص Sheets("Sheet1").Range("A2:F20").Select ' تحديد الخلايا التى تتضمن أخطاء Selection.SpecialCells(xlCellTypeFormulas, 16).Select ' استدعاء صوت من أصوات الويندوز للتنبيه على انتهاء الفحص PlaySound = True If PlaySound Then Call sndPlaySound32("C:\windows\media\notify.wav", 1) ' حدد الصوت المفضل لك طبقاً للمسار المقابل End If ' رسالة الى المستخدم بسؤال عن الرغبة فى التمييز أم لا If MsgBox(" تم انتهاء الفحص , هل تريد تمييز الخلايا ؟ ", vbYesNo + vbQuestion) = vbNo Then Exit Sub ' فى حالة اختيار لا يتم الخروج من الاجراء Else ' فى حالة اختيار تعم يتم عمل تمييز للخلايا بالتفريغ أو بالتعديل أو التلوين أو الفلاش ' ------------------------------------------------------------ ' تمييز الخلايا التى بها اخطاء بالتعديل ' For Each C In Sheets("Sheet1").Range("A2:F20") ' If IsError(C.Value) Then ' C.Value = "معادلة خاطئة" ' End If ' Next C '------------------------------------------------------------- ' تمييز الخلايا التى بها اخطاء بالتفريغ ' For Each C In Sheets("Sheet1").Range("A2:F20") ' If IsError(C.Value) Then ' C.Value = "" ' End If ' Next C '------------------------------------------------------------- ' تمييز الخلايا التى بها اخطاء بالتلوين ' For Each C In Sheets("Sheet1").Range("A2:F20") ' If IsError(C.Value) Then ' C.Interior.ColorIndex = 3 ' End If ' Next C '------------------------------------------------------------- ' تمييز الخلايا التى بها اخطاء بالفلاش For Each C In Sheets("Sheet1").Range("A2:F20") If IsError(C.Value) Then C.Select With C For i = 1 To 2 ' عدد مرات الوميض Application.Wait (Now + TimeValue("0:00:01")) ' انتظار مؤقت لمدة ثانية .Interior.ColorIndex = 6 Application.Wait (Now + TimeValue("0:00:01")) .Interior.ColorIndex = 7 Next .Interior.ColorIndex = xlNone .Font.Color = -16777024 End With End If Next '------------------------------------------------------------ End If End Sub تفضلوا المرفق وتقبلوا تحياتى select all cells if contains Error value .rar

جزاك الله خيرا

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

أخي الكريم يمكنك وضع رابط الفيديو لتجد المساعدة من إخوانك كما يرجى إرفاق ملفك للعمل عليه

أخي الكريم أحمد الطحان يرجى تغيير اسم الظهور للغة العربية جرب المعادلة التالية في الخلية E27 =MOD(SUM(E15:E26),24) والمعادلة التالية في الخلية F27 =SUM(F15:F26,INT(MOD(SUM(E15:E26)/24,24))) تقبل تحياتي

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

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

استادي الفاضل أنس دروبي تفضل الكود في اليوزرفورم Private Sub CommandButton1_Click() If MsgBox("Do you want to add this workbook to the Windows startUp ?", vbYesNo + vbQuestion) = vbYes Then AddToWinStartUp ThisWorkbook.FullName, True End If End Sub Private Sub AddToWinStartUp(ByVal File As String, ByVal Add As Boolean) CreateObject("wscript.shell").RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\", IIf(Add, File, vbNullString), "REG_SZ" End Sub

كود جميل للاستاد الفاضل مختار حسين عند بعض الملاحظات 1- من الأفضل اضافة Error Handling للكود لتفادي ال RunTime error في حالة عدم وجود أي خلايا تحتوي على معادلات في الصفحة 2- يمكن الاستغناء عن Select ليكون الكود أسرع 3- في حالة وجود أكثر من خلية حاوية لمعادلة يمكن اشغال الوميض على كل الخلايا مرة واحدة في نفس الوقت .. هدا الأمر من شانه الاسراع بالكود خصوصا لو وجدت خلايا عديدة 4- من الأحسن تغيير شكل الكود بحيث يصبح التعديل و التفريغ و التلوين و الوميض Arguments يتم اختيارهم من طرف المستخدم .. هدا من شأنه اعطاء للكود مرونة كبيرة

الأساتدة الافاضل ياسر و توكل كما سبق لي أن قلت لم أجرب الكود و اعتمدت فقط على ال ASCII MAP للحروف العربية لكي أجرب الكود يجب أن أغير السيتينس عبر Control Panel-Regional Settings لكن الجهاز يطلب مني ادخال سيدي الويندوز XP الدي ضاع مني

يعنى اخى الكريم / jjafferr هذا الكود لفتح النموذج على اخر سجل به بيانات اعتذر إليك حيث انى حديث عهد ببرنامج أكسيس وشكرا جزيلا على المعلومه القيمه DoCmd.GoToRecord , , acLast

أخي إسلام الموضوع كان عن: بينما ردك كان لإنشاء سجل جديد!! جعفر

وعليكم السلام الامر هو: DoCmd.GoToRecord , , acLast ويعمل على جميع اصدارات الاكسس جعفر

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

تشكر اخي وائل بعد اذنك اضافة بسيطة Book1 salim.zip

السلام عليكم ورحمة الله انا لا اعلم طريقتك وفكرتك مع المستخدم , بإمكانك تسليم المستخدم الملف فقط دون إعطائة كلمة المرور وعندما يغلق عليه الملف سيرجع لك إلا اذا كان المستخدم بعيد عن منطقتك او مدينتك فهذا حال ثاني ، ممكن نعمل لك كلمة مرور تتغير بتغيًر التاريخ او الوقت او التاريخ والوقت.مثلا تظهر لك رسالة بالوقت والتاريخ وتحجزهم في متغيًر ثم تقوم بعملية حسابية لتكوين كلمة المرور فأنت عليك فقط تحتفظ بطريقة العملية الحسابية فعند الاتصال بك هاتفيا واخبرك بمطالبتة بكلمة مرور قل له شغل الملف ستظهر له رسالة وبها مثلا التاريخ 15/10/2015 إليك مثال ادناة. مثال / بالتاريخ فقط نختار العملية الحسابية علي التاريخ لو افترضنا ان العملية الحسابية جمع اليوم والشهر وننقصهم من السنة فالناتج 15+10=25 ..... 2015-25 =1990 فالناتج هو كلمة المرور وهكذا إذا تغير التاريخ. فقط احتفظ بطريقة العملية الحسابية فلما يطلب منك المستخدم كلمة المرور قل له ماهو التاريخ اللي ظهر لك بالرسالة اعطيني إياه واضغط موافق علي الرسالة سيفتح له مربع إدخال InputBox قم انت بالعملية الحسابية واخبر المستخدم بإدخال 1990 كمثالنا السابق .فإن 1990 كلمة مرور ذلك اليوم فقط وليست ثابتة لأن التاريخ سوف يتغيًر وستصبح كلمة المرور1990 بعد ذلك اليوم عديمة الفائدة .هنا كلمة المرور تتغير كل يوم لكن مع الوقت تستطيع ان تجعلها تتغيًر حسب رغبتك كل ساعة او كل دقيقة او كل ثانية وبالنسبة لمثل ملفك والذي تطالب بكلمة المرور بعد فتره طويلة فلا تحتاج التغيير بالوقت فبالتاريخ افضل واسهل لك في حفظ طريقة العملية الحسابية.

رائع اخي وائل احمد المصري خاص تحياتي

اخى العزيز تم عمل ما تريد ابجدة حسب النوع والصف تلاميذ المدرسة.rar

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

اساذنا العزيز وهنا عملت على تصغير حجم قاعدة بياناتك ، فصغرت من 56MB الى 12MB جعفر Folow up V.2.zip

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

وعليكم السلام . هل مخترفى الاكسس على وزن المخرفين الاجابة بالصور من التقرير: لا يوجد عندك تذييل لقسم sit: . فعملنا التذييل ، وغيرنا في اعداداته: . والنتيجة: جعفر 227.Human Resources DataBase.mdb.zip

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

اخي الفاضل هذان السطرا تم ايقافهما بالعلامة الموضوعة علي يسار كل سطر 'PURPOSE: Different ways to find the last row number of a range 'SOURCE: www.TheSpreadsheetGuru.com هذان السطران تعريف لمتغيرات يختارها المبرمج ويقوم بتعريف البرنامج عليه وعلي ماذا تشير Dim sht As Worksheet Dim LastRow As Long هذا السطر جعل المبرمج احد المتغيرات عندما يذكرها فانها تشير الي الشيت رقم 1 في هذا الملف Set sht = ThisWorkbook.Worksheets("Sheet1") هذا السطر تم ايقافه 'Ctrl + Shift + End هنا يعرف المبرمج المتغير الثاني وهو يشير الي الصف الاخير للخلاياالغير فارغة في العمود الاول من الشيت الاول LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row هذا السطر تم ايقافه(ويعتبر كعنوان لايؤثر في الكود) 'Using UsedRange هنا يتم معرفة مدي الخلايا المستخدمة sht.UsedRange 'Refresh UsedRange هنا جعل المتغير الثاني يساوي اخر صف في صفوف المدي المستخدم LastRow = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row هذا السطر تم ايقافه(ويعتبر كعنوان لايؤثر في الكود 'Using Table Range هنا جعل المتغير الثاني يساوي عدد صفوف الجدول المستخدم LastRow = sht.ListObjects("Table1").Range.Rows.Count هذا السطر تم ايقافه(ويعتبر كعنوان لايؤثر في الكود 'Using Named Range هنا جعل المتغير الثاني يساوي عدد صفوف مدي مخفوظ LastRow = sht.Range("MyNamedRange").Rows.Count هذا السطر تم ايقافه 'Ctrl + Shift + Down (Range should be first cell in data set) هنا جعل المتغير الثاني يساوي عدد صفوف الخلايا المستخدمة LastRow = sht.Range("A1").CurrentRegion.Rows.Count End Sub ارجو ان تكون هناك افادة تحياتي

حسب ما فهمت من المشاركة اليك هذا الملف المعدل (انظر الى الورقة 2) بالنسبة لتمكين الماكرو افعل ما يلي 1-اضغط على التبويب Developer 2 -اختر Macro Security 3-macro sittings 4 - اختر اخر خيار ضع (ضع نقطة في اخر دائرة) 5-ضع علامة (صح)في المربع الوحيد 6 -Ok لائحة جاهزة اسعار الجملة 2015 salim 1.zip

جرب هذا الملف انه يعمل بشكل آلي بمجرد ما تغير شيئاَ في الجدول الثاني لائحة جاهزة اسعار الجملة 2015 salim.zip

لو سمحت هل فام أ / محمد بعمل كنترول شيت للتعليم الزراعي كما طلبت أرجو الأفادة

http://www.mediafire.com/download/2ut575z5k6q9s7h/برنامج_الكومى_لعمل_الارقام_السرية.rar تم التعديل بتاريخ 14 ديسمبر 2014

كرما منكم اريد رابط نسخه اوفيس 2003 بشرط ان تكون بتفتح الملف الموجود بالمشاركة http://www.officena....showtopic=33890

المجموعة الثانية المجموعة الثانية.rar

السلام عليكم بعد اذن اخي الحبيب ابو اسامة يمكنك البحث من خلال الخلية A6 Private Sub Worksheet_Change(ByVal Target As Range) Dim X As Integer, Y As Integer KH_Range If Target.Address = MyCell.Address Then If MyCell <> "" And IsNumeric(MyCell) Then X = MyCell.Value + 3 For Y = 1 To 21 MyRange.Areas(Y) = ورقة2.Cells(X, Y + 2) Next Y Else MyRange.ClearContents End If End If End Sub وتعديل البيانات وترحيلها مرة اخرى Public MyRange As Range, MyCell As Range Sub KH_Range() Set MyRange = ورقة1.Range("B6,C6,A12,B12,C12,D12,E12,F12,G12,H12,A15,B15,C15,D15,E15,F15,G15,H15,E6,F6, G6") Set MyCell = ورقة1.Range("A6") End Sub Sub KH_START() Dim X As Integer, Y As Integer KH_Range If IsEmpty(MyCell) Or IsNumeric(MyCell) = False Then MsgBox "استخدام خاطىء": GoTo 1 X = MyCell.Value + 3 For Y = 1 To 21 ورقة2.Cells(X, Y + 2) = MyRange.Areas(Y) Next 1 MyCell.ClearContents End Sub تفضل المرفق ___________.rar

السلام عليكم ممكن نعدل في الكود حسب ما تريد Sub ttt() x = ورقة2.Cells(Rows.Count, 5).End(xlUp).Row + 1 For y = 3 To 28 ورقة2.Cells(x, y) = Range("r_" & y - 2) 'Range("r_" & y - 2) = "" هذا السطر ان اردت مسح الخلايا بعد الترحيل Next End Sub ___________1.rar

السلام عليكم قمت بتغييرهما و الملف يعمل لان العمل بمنطق(1+1 = 2 ) الكود يتعامل مع كود الورقة و ليس اسمها Test_them_Again.rar

السلام عليكم و رحمة الله شاهد المرفق test.rar