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

جرب هذا ::::::: Dim RanNo() As Long Private Sub RandomizeNumbers(ByVal iFrom As Integer, ByVal iTo As Integer) ReDim RanNo(iFrom To iTo) For i = iFrom To iTo RanNo(i) = i Next i Randomize (Timer) For i = iFrom To iTo j = CInt((iTo - iFrom) * Rnd + iFrom) tmp = RanNo(i) RanNo(i) = RanNo(j) RanNo(j) = tmp Next i End Sub Private Sub أمر0_Click() RandomizeNumbers 0, 28 For i = 1 To 28 List1.AddItem RanNo(i) Next i End Sub

تفضل طريقة اخرى ......... 'السابق Me.نص1 = Me.نص1.ItemData(Me.نص1.ListIndex - 1) 'التالي Me.نص1 = Me.نص1.ItemData(Me.نص1.ListIndex + 1) 'اول سجل Me.نص1 = Me.نص1.ItemData(0) 'اخر سجل Me.نص1.Selected(Me.نص1.ListCount - 1) = True

إذا كان الهدف اختصار الكود فجرب هذا تم تحويل النطاق من range إلى cells للتحكم في رقم العمود بدلا من الحرف الخاص به Sub mySort() For c = 2 To 48 Step 2 Range(Cells(5, c), Cells(Cells(Rows.Count, c).End(xlUp).Row, c)).Sort Key1:=Cells(5, c), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal Next c MsgBox "Done by mr-mas.com" End Sub بالتوفيق

طيب انظر الصور والمرفق هل هذا هو المطلوب ........ Info list.accdb

مع التحية والتقدير للاستاذ محمد البرناوي على الحل الرائع ومن باب تعدد الحلول ولكوني من المدرسة القديمة ومن انصار استخدام مربعات النص لاختصار الاكواد فاني سوف اضع طريقة ليست منافسة للكود الرائع لاستاذنا الفاضل ولكن حل على طريقة الطيبين في البداية استخدمنا مربع نص غير منضم اسميته tx3 وقيمته تساوي Me.tx3 = tx3 & "'" & Curr_Grp.Column(0) & "'," ثم في زر الامر لفتح التقرير وضعنا الامر Dim k, w As String k = tx3 w = "st_mstr.Curr_Grp IN (" & Left(k, Len(k) - 1) & ")" DoCmd.OpenReport "r_1", acViewPreview, , w والنتيجة في الصورة تحياتي

للسهم اعلى DoCmd.GoToControl "نص1" SendKeys ("{up}") للسهم اسفل DoCmd.GoToControl "نص1" SendKeys ("{DOWN}")

ومن دون الكود الطويل لديك ..... استخدم هذا ..... مشاركة مع اخي الكريم واستاذي @Barna بارك الله فيه ..... Dim DstFile As String DstFile = CurrentProject.Path & "\" & Format(Now, "hhmmss") & ".doc" DoCmd.OutputTo acOutputTable, "tabasd", "RichTextFormat(*.rtf)", DstFile, True, "", 0, acExportQualityPrint

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

وعليكم السلام-تفضل 1الاحصاء.xlsx

تمكين المحتوى هو الزر الأصفر الذي يظهر في بداية فتح ملف يحتوي على أكواد في حالة ارتفاع نسبة الأمان في برنامج الاكسل أما عن تنفيذ الكود في الشيت المحمي ففي هذه الحالة يجب وضع كود فك حماية الشيت في أول سطر في الكود بعد اسم الاجراء sub name ActiveSheet.UnProtect "password" ووضع كود وضع الحماية في آخر سطر في الكود قبل end sub ActiveSheet.Protect "password" مع كتابة كلمة المرور بدلا من كلمة password بالتوفيق

جرب التعديل وانتظر حتى ظهور الرسالة ...... Dim MWordDocCopyOf As String Dim NWordDocCopyOf As String Dim LWordDocOriginal As String Dim LWordDocCopyOf As String Dim Warning As String DoCmd.GoToRecord , , acFirst For i = 1 To Me.Recordset.RecordCount If Dir(CurrentProject.Path & "\" & Me.المعرف & "\", vbDirectory) <> "" Then Else MkDir CurrentProject.Path & "\" & Me.المعرف & "\" End If LWordDocOriginal = CurrentProject.Path & "\asd.docx" LWordDocCopyOf = CurrentProject.Path & "\" & Me.المعرف & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" If IsFileLocked(LWordDocCopyOf) = True Then MsgBox "يرجى غلق ملف الوورد!" Application.FollowHyperlink LWordDocCopyOf Exit Sub Else FileCopy LWordDocOriginal, LWordDocCopyOf MWordDocCopyOf = LWordDocCopyOf NWordDocCopyOf = Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" Dim LWordDoc As Object Set LWordDoc = CreateObject("Word.Application") LWordDoc.Documents.Open MWordDocCopyOf LWordDoc.Visible = True LWordDoc.ActiveDocument.Bookmarks("A1").Select LWordDoc.Selection.InsertAfter Nz(b1.Value, "") LWordDoc.ActiveDocument.Bookmarks("A2").Select LWordDoc.Selection.InsertAfter Nz(b2.Value, "") LWordDoc.ActiveDocument.Bookmarks("A3").Select LWordDoc.Selection.InsertAfter Nz(b3.Value, "") LWordDoc.ActiveDocument.Bookmarks("A4").Select LWordDoc.Selection.InsertAfter Nz(b4.Value, "") LWordDoc.ActiveDocument.Bookmarks("A5").Select LWordDoc.Selection.InsertAfter Nz(b5.Value, "") LWordDoc.Application.Documents(NWordDocCopyOf).Save End If LWordDoc.Quit Set LWordDoc = Nothing DoCmd.GoToRecord , , acNext Next i Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbOKOnly, "تنبيه")

كنت قبل ذلك قد ذكرت عدة أكواد من حروف البدل أستخدمها في البحث والاستبدال، والآن أضفت عدة أكواد جديدة، أحببت أن أنشرها هنا للفائدة: • البحث عن كلمة أولها (ال) وآخرها (تنوين) <ال[! ]@[ًٌٍ]> • كلمة أولها (ال) وآخرها (ون) ليس بعدها (فتحة) ال[! ]@(ون)[!َ]> • البحث عن أي كلمة أو رمز، أو رقم: <[! ]*> • البحث عن أي كلمة، وهي تصلح في عمل الماكرو: <[أ-ىيئءؤءاإًٌٍَُِّْ]@> • أو: <[أ-يًٌٍَُِّْ]@> • البحث عن أي كلمة: <[أ-ي]@> • البحث عن أي كلمة: <[! ]@> يكتب قبلها كلمة عند البحث والاستبدال لأنها تبطئ الماكرو، وربما تهنج الورد. • البحث عن أي كلمتين: <[! ]@> <[! ]@> • البحث عن أي كلمتين الأولى تبدأ بهمزة، والثانية تنتهي بتاء مربوطة: <أ[! ]@> <[! ]@ة> • البحث عن أي كلمتين الأولى آخرها ألف، والثانية تنتهي بالألف: <[! ]@ا> <[! ]@ا> • البحث عن كلمتين متتاليتين مكررتين: (<* ){2} ، ويمكن البحث بـ{3، 4} أو <([أؤئإءيا-ى]@)> \1> • البحث عن كلمتين، أو عددين، أو جملتين متتاليتين مكررتين بينهما فاصلة: (<*>)، \1 • البحث عن جملتين متتاليتين مكررتين: (<*>) \1 • ولحذف الكلمة أو الجملة المكررة نضع في مربع الاستبدال: \1 • البحث عن أي كلمتين أو حرفين أو رقمين متتاليين متطابقين: (<*){2} • البحث عن أي رقمين متتاليين بينهما فاصلة مثل 22، 22، ويمكن بـ{3، 4}: (<*){2}، (<*){2} • البحث عن فقرتين متتاليتين متطابقتين: (*^13)\1 • البحث عن ثلاث فقرات متتالية متطابقة: (*^13)\1\1 • البحث عن فقرة قبلها فقرة فارغة وبعدها فقرة فارغة: ^13{2}([!^13]@^13)^13 • البحث عن فقرة قبلها فقرة فارغة: ^13{2}([!^13]@^13) • البحث عن فقرة قبلها أو بعدها فقرة فارغة: ^13{2}([!^13]@) • ولحذف هاتين الفقرتين الفارغتين ضع في خانة الاستبدال: ^p<H1>\1 • البحث عن الفقرات المكررة بشكل متتالي: (*^13)(\1)@ • البحث عن فقرة عن طريق حروف البدل: ^13 • البحث عن فقرة قبلها أي حرف عن طريق حروف البدل: >^13 ، وبعدم اعتبار المسافة آخر الفقرة: >^13* • البحث عن أي فقرة إلى كلمة (في) مثلا للتظليل: <[! ]*في> • تحديد ما بين الفاصلتين: ، <[! ]*>، • تحديد ما بين كلمتين مثل: عن <[! ]*> عن • البحث عن أي كلمة مكونة من حرفين: <[! ]@{2}> • البحث عن أي كلمة مكونة من حرفين آخرها تنوين: <[! ]@{2}[!ًٌٍ]> البحث عن كلمة خمس حروف ليس منها علامات الضبط: <[! ]@{5}[ًٌٍَُِّْ]> • للبحث عما بين قوسين هلاليين: (\(*)\) أو \(?@\) • للبحث عما بين معقوفين: \[?@\] • للبحث عن أي رقم دون الحروف: [0???-9] • للبحث عن أي كلمة دون الأرقام: <[أ-ى][! ]@> • للبحث عن أي رقمين بينهما فاصلة: [0???-9]، [0???-9] • للبحث عن الحروف والأرقام دون المسافات وعلامات الترقيم: [أ-ي0-9] • لتحديد ما بين شرطتين مائلتين: / [???0-9]*/ • البحث عن الحاشية السفلية مع حروف البدل: ^2 • لجعل علامة الحاشية بين قوسين: في مربع بحث اكتب الآتي ^f وفي مربع استبدال اكتب (^&) وهذا الكود يعني أن المكتوب في خانة البحث يساوي المكتوب في خانة الاستبدال، فيمكن استخدامه مع أي حرف وأي رقم، حيث الاستبدال لا ينفع مع أي حرف وأي رقم، لكن بإضافة هذا الكود يصبح الاستبدال متاحا. • للبحث عن أي رقم بعده صفر (0) بعده سلاش (/) على صورة (08/): 0^#/

جميعا بإذن الله

الكود يرتب الأسماء المكتوبة فقط يعني لو مكتوب في العمود B خمسين اسم يرتب من B5:B54 وهذا هو التعديل الذي تمت اضافته مني لان الكود القديم يرتب 200 صف بغض النظر عن عدد الأسماء رجاء دراسة الكود جيدا قبل الرد

وعليكم السلام استاذ ابو عبد الله .. لدي كود random لايكرر الارقام ...لا اعلم ان كان يفيدك فقد جربته على 28 سجل random.rar

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

العين لا تعلو على الحاجب ..... عارف حتقول اذا كان الشخص مقلوب ..... هههههههه

شكرا لتعب حضرتك

شكرا لحضرتك

في هذه الحالة انصحك بإلغاء تثبيت الاوفيس ثم تثبيته مرة أخرى

تفضل جرب Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim x Dim lr Dim lrr On Error Resume Next lrr = Cells(Rows.Count, "c").End(3).Row If Not Intersect(Target, Range("c2:c" & lrr)) Is Nothing Then If Target = "" Then Exit Sub lr = Cells(Rows.Count, "e").End(3).Row For x = 4 To lr If Target.Offset(, -1).Text = Cells(x, "e").Text Then Cells(x, "f") = Val(Cells(x, "f")) + Val(Target): Exit For End If Next x End If End Sub مخزن 1992.xlsm

جرب استعمال هذا السطر Private Sub comboBox1_Change() TextBox1.Value = Evaluate("=MAXIFS(Sheet2!A:A,Sheet2!C:C,""" & ComboBox1.Value & """)+1") End Sub باستعمال maxifs تقريبا تعمل في اوفيس 2013 وما بعده ويمكن استعمال هذا السطر لنسخ الأوفيس القديمة TextBox1.Value = Evaluate("=MAX(IF(""" & ComboBox1.Value & """=(Sheet2!C$2:C$100),(Sheet2!A$2:A$100)+1,1))") بالتوفيق

لا مشكلة في الكود والترحيل صحيح فقط قم بحذف السطور المكتوبة بالأسفل تقريبا في الصف 202 وسيرحل بعدها الى بعد 100 بالتوفيق

بالتوفيق. Forme.xlsb

حياك الله اخي الغالي @kanory اهلا شرفتنا ... دائما الاستاذ يبقى استاذ .... منكم نتعلم استاذي الكريم .... شكرا لمرورك

يمكنك استعمال هذه المعادلة في الخلية B9 للحصول على المطلوب الأول =IF(SUMPRODUCT(IF($B$1:$B$4=TRUE,1,0),TRANSPOSE(INDEX(Data!$C$2:$F$11,MATCH(B8,Data!$B$2:$B$11,0),{1,2,3,4})))=SUM(IF($B$1:$B$4=TRUE,1,0)),"","غير ")&"مناسب" وبالنسبة للمطلوب الثاني يمكن الوصول لجميع أفراد المجموعة التي منها هذا الاسم ومعرفة ومن منهم مناسب ومن منهم غير مناسب في الخلايا D1:I7 ويمكن سحب المعادلة في العمود D & E لأسفل إذا زاد عدد المجموعة وهذا لاختيار البديل يدويا كما في الملف المرفق بالتوفيق المناسب للهوايات المختارة.xlsx

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

ههههههه في اللغة العربية تطلق كلمة شيخ على ثلاث الكبير في السن قال الله تعالى "قَالَتَا لَا نَسْقِي حَتَّىٰ يُصْدِرَ الرِّعَاءُ ۖ وَأَبُونَا شَيْخٌ كَبِيرٌ" الوجية في قومة ذو الرئاسة او الجاه عالم الدين على كل حال لو لم تتوفر في رقم 2 و3 يبقى رقم واحد تحياتي

شكرا اخ Barna وهو المطلوب اثابته والشكر موصول الى المهندس قاسم والاخ خالد

جميعا بإذن الله

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

يمكنك تجربة هذا الملف تم جلب أول 3 أسماء في العمود A ووضعها في العمود D وكذلك أول 3 أسماء في العمود C ووضعها في العمود E واستعمال معادلة العد بشرط =COUNTIF(E:E,D2)>0 لاستعمالها في تلوين خلايا العمود D عن طريق التنسيق الشرطي بالتوفيق مقارنة أول 3 أسماء.xlsb

الملف مع تجربه المعادلة تجميع تاريخ.xlsx

وعليكم السلام-لابد من رفع الملف نفسه لوضع المعادلة تماماً فى المكان المخصص لها وتجنباً لإهدار الوقت ... ويمكن هذا بمعادلة Date ... ,وبما انك لم ترفع الملف فيمكنك وضع المعادلة بنفسك فى المكان المخصص لها طبقا لملفك والخلايا المعلومة لك والمجهولة بالنسبة لنا =Date(Year,Month,Day)

لقد نسيت اضافة شرط عدم تكرار الموقع ..ان كنت مهتما بالشغل الاولي ..استبدل الكود السابق بهذا الكود (بعد التحديث) Private Sub mawqeecod_AfterUpdate() On Error Resume Next Dim Testitem As String Dim Testmawq As String Dim Testid As Long Testitem = Nz(DLookup("itemcodadd", "Copy Of insertdata", "itemcodadd = '" & Me.itemcod & " '"), 0) Testmawq = Nz(DLookup("mawqeecodadd", "Copy Of insertdata", "itemcodadd = '" & Me.itemcod & " '" & "AND mawqeecodadd = '" & Me.mawqeecod & " '"), 0) If Testitem > 0 And Testmawq > 0 Then Dim Msg, Style, Title, Response Msg = "المادة موجودة في .... " & Testmawq & vbCrLf & "?....هل تريد اضافتها" Style = vbYesNo Or vbCritical Or vbDefaultButton2 Title = " تكرار مادة في نفس الموقع " Response = MsgBox(Msg, Style, Title) If Response = vbYes Then DoCmd.SetWarnings fales DoCmd.RunSQL "INSERT INTO Mawaqee ( mawqeename )SELECT [forms]![Copy Of insertdata]![mawqeecod] AS myItem1;" DoCmd.SetWarnings True Else Cancel = True Me.mawqeecodadd = "" End If End If End Sub اما بالنسبة لمشاركتك الاخيرة ..رغم اني لا افضل تعدد الجداول ...لكن اتفهمك ان كانت المواقع محدودة ولعدم تكرار اسم الموقع طبعا اهملت نموذجك ..لان حسب فهمي ان النموذج حينما يكون مفتوحا فانه لايرى تغييرمصدر السجلات ..ولهذا عملت نموذجا اخر فيه ازرارلفتح النموذج برنامج حصر العهد بالفرع.rar

يمكنك استعمال هذه المعادلة في الخلية C13 =IFERROR(INDEX($A$3:$A$10,SMALL(IF(C$3:C$10="ح",$A$3:$A$10),ROW()-12))&" "&INDEX($B$3:$B$10,SMALL(IF(C$3:C$10="ح",$A$3:$A$10),ROW()-12)),"") مع سحب المعادلة يسارا ثم أسفل وهذا ملفك بعد كتابة المعادلة فيه فربما لا يعرف أحدنا كيفية إضافة المعادلات للملفات بالتوفيق كتابة مسلسل واسم الشخص في خلية واحدة؛ وتعديل معادلة.xlsx

شكرا استاذ عبد الفتاح لمساعده حضرتك

السبب في البطء هو استعمال معادلة المصفوفات لأكثر من 70 مرة والصواب استعمالها مرتين فقط مع استثناء الصفوف الفارغة من المعادلة تم تعديل المعادلة في عمود البنات إلى =IFERROR(INDEX(الأسماء!$B$2:$B$1000,SMALL(IF(الأسماء!$C$2:$C$1000=$I$1,IF(الأسماء!$F$2:$F$1000="أنثى",ROW($1:$999))),ROW()-3)),"") لاحظ بداية ونهاية المدى 2:1000 يجب أن تكون متطابقة ما عدا الصف الذي يتم إرجاعه فيكون أقل ب 1 واستعمال row - 3 للترتيب مع العلم انه يجب تحديد الخلايا B4:B42 قبل لصق المعادلة في شريط الصيغة مع الضغط على. Ctrl+Shift+Enter وهكذا مع عمود البنين وهذا ملفك بعد التعديل بالتوفيق قوائم 2022 - قبل القسيم.xlsb

على العموم دى فكرة بسرعة ☺️ تم تعديل المرفق لتلافى مشكلة عدم وجود صوت ضمن اعدادت الويندوز Waiting Role.zip

عزيزى الغالى هشام بك شلبى فى المرفق الطالب رقم 4 هشام4 ناجح فى العربى بدرجة 49 من 80 ورغم ذلك البرنامج أعطاه 40 من 80 فى درجة الطالب فأحب أن ألفت نظر سيادتكم بأن الطالب الناجح فى المادة يحتفظ بدرجته الأصلية فى هذه المادة

الأستاذ الفاضل هشام تقبل كل الشكر و التقدير .. عمل متميز فعلاً لي - إذا سمحت - ملاحظة صغيرة : الخلية A1 في صفحة الغلاف و هي المخصصة لوضع باسوورد فك الكتشنة مغلقة فإذا تكرمت بفتحها ليضع فيها المستخدم الباسوورد التي يريدها سيكون ذلك أفضل مع إمكانية أن تكون مخفية عن الآخرين فلا يعرف أحد غير المستخدم للبرنامج هذه الباسوورد

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

عزيزى الغالى واستاذى الكريم هشام بك أولاً عمل طيب ومتعوب فيه ربنا يباركلك ثانياً عندى 5 ملاحظات صغيرة 1. بالنسبة لشيت الرصد حضرتك أغفلت نقطة صغيرة وهى أن الطالب اللذى يدخل المادة فى الدور الثانى لا تحتسب له كل الدرجة التى يحصل عليها فى إمتحان الدور الثانى بل فقط يحصل على 50% من الدرجة الكلية للمادة (أى درجة النجاح) فمثلاً طالب عنده دور ثانى فى اللغة العربية وهى مادة من 80 درجة وكانت درجته فى إمتحان الدور الأول 35 ودخل الدور الثانى وحصل على 50 درجة المفروض أن البرنامج يحسب له درجة المادة 40 فقط وهى درجة النجاح 2. بالنسبة لمسميات رؤوس الأعمدة اقترح تغيير كلمة المجموع فى كل مادة لكلمة درجة الطالب حيث درجة الدور الثانى لا تجمع بل ترصد للطالب الدرجة الفعلية التى حصل عليها فى الورقة ثم يتعامل معها البرنامج حسبما ذكرت لسيادتكم فى النقطة السابقة 3. لا تستخرج للطالب الراسب شهادة سواء من له حق الإعادة أو من ليس له بل الشهادة للطالب الناجح والمنقول للفرقة الأعلى أما الراسبون فتستخرج لهم كشوف مجمعة فقط كذلك الناجحون تستخرج لهم كشوف نتيجتهم بالإضافة للشهادات السابق الإشارة إليها 4. الطالب الذى دخل إمتحان الدور الثانى وهو ناجح فى المجموع يكون من حقه أن يزداد مجموعه الكلى بفارق الدرجات التى إضيفت له فى درجة المادة المشار إليها فى النقطة 1 بينما الطالب الذى دخل إمتحان الدور الثانى وكان مجموعه فى إمتحانات الدور الأول أقل من 50% من الدرجة الإجمالية فهذا فى حالة نجاحه فى مواد الدور الثانى ومهما كانت الدرجات التى حصل عليها فى مواد الدور الثانى لا يزيد مجموعه الكلى فى الدور الثانى عن 50% من المجموع الكلى 5. بالنسبة للأنشطة هى ليست مواد رسوب حتى لو تغيب الطالب فى الأنشطة سواء دور أول أو ثانى دمت بود وربنا يوفقك