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

مشاركه مع استاذي @ابوخليل تفضل أخي . تجربة-1.accdb

Sub Sheets_Arrays1() Dim temp As Variant Dim arr As Variant Dim F As Boolean Dim ws As Variant Dim WSdata As Worksheet: Set WSdata = Sheets("Total") For Each ws In Sheets(Array("1", "2", "3")) temp = ws.Range("k5:N" & ws.Cells(Rows.Count, 11).End(xlUp).Row).Value If F Then arr = ArrayJoin(arr, temp) Else arr = temp F = True End If Next ws With Sheets("Total") .Range("C4").Resize(1, 4).Value = Array("م", "الاسم", "الرقم الوظيفي", "سعد") .Range("C5").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr End With End Sub '''''''''''''''''''ترحيل البيانات في اخر صف فارغ''''''''''''''''''''''' Sub Sheets_Arrays2() Dim F&, j& Dim ws As Variant Dim WSdata As Worksheet: Set WSdata = Sheets("Total") WSdata.Range("C4").Resize(1, 4).Value = Array("م", "الاسم", "الرقم الوظيفي", "سعد") For Each ws In Sheets(Array("1", "2", "3")) F = ws.Cells(Rows.Count, "K").End(xlUp).Row j = WSdata.Cells(Rows.Count, "C").End(xlUp).Row Application.ScreenUpdating = False ws.Range("K5:N" & F).Copy Destination:=WSdata.Range("C" & j + 1) Application.ScreenUpdating = True Next ws End Sub ترحيل من عدة صفحات V3.xlsm

The topic must be CLOSED as you did not respond properly to Mohamed Hicham in a good way Generally, I will share my idea but I will not extend my reply if you have more questions First create a userform with TextBox1 & ListBox1 controls Second paste the following code on userform module Option Explicit Private arrData, ws As Worksheet Private Sub UserForm_Initialize() Dim lr As Long Set ws = ThisWorkbook.Worksheets(1) lr = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row arrData = ws.Range("C3:C" & lr).Value Me.ListBox1.List = Application.Transpose(arrData) End Sub Private Sub TextBox1_Change() Dim txt As String, i As Long Me.ListBox1.Clear If Len(Me.TextBox1.Value) = 0 Then Me.ListBox1.List = Application.Transpose(arrData): Exit Sub txt = Me.TextBox1.Value For i = LBound(arrData) To UBound(arrData) If InStr(LCase(arrData(i, 1)), LCase(txt)) > 0 Then Me.ListBox1.AddItem arrData(i, 1) End If Next i End Sub Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim x x = Application.Match(ListBox1.Value, ws.Columns(3), 0) With ws.Range("H3").Resize(, 4) .ClearContents If Not IsError(x) Then .Value = ws.Range("B" & x).Resize(, 4).Value Unload Me End If End With End Sub Now right-click the worksheet name and select [View Code] and paste the following code Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = "$H$3" Then Cancel = True UserForm1.Show End If End Sub The code usage -------------------- Double click on cell H3 and the form will be shown then type some letters of the name you need to search and finally double click the name on the listbox to get the results in the range H3 to K3 Regards

تفضل اخي circle.xlsm

هذه نسخة من التقويم الدراسي والمواعيد وتنظيم الأعمال والمشاريع بدون أكواد VBA وقريبا بإذن الله سأضع نسخة بالأكواد الهدف منها حفظ صورة من التقويم للاستفادة منها كخلفية لسطح المكتب في هذا الملف وضعت بيانات التقويم الدراسي في السعودية مع العلم أنه يمكن التعديل على هذه البيانات حسب حاجة المستخدم كتنظيم الأعمال ومراحل إدارة المشاريع وغيرها من الأعمال الأخرى ‏‏التقويم الدراسي والمواعيد - وتنظيم الأعمال والمشاريع.xlsx

انظر هل هذا ما تريد """""" test (1).mdb

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

اضافه للنابغه الأستاذ حسونه حسن يبارك له ربنا اربط هذا الكود بزر الاستدعاء Sub Test(Arr1 As Variant) ' ترحيل قائمة التلاميذ بناء على رقم الفصل '------------------------------------------------- Dim Ws As Worksheet, Sh As Worksheet Dim Arr As Variant, Temp As Variant ', Arr1 As Variant Dim LR As Long, i As Long, j As Long, p As Long '----------------------------------------- Set Ws = Sheets("المواد منفصله") Set Sh = Sheets("data1") LR = Sh.Cells(Rows.Count, 2).End(xlUp).Row Ws.Range("C5:H34").ClearContents Arr = Sh.Range("A7:AB" & LR).Value ReDim Temp(1 To UBound(Arr, 1) + 1, 0 To UBound(Arr1) + 1) For i = 1 To UBound(Arr) '------------------------------------------ If Arr(i, 4) = Ws.Range("D3").Value Then '------------------------------------------ p = p + 1 For j = 0 To UBound(Arr1) Temp(p, j) = Arr(i, Arr1(j)) Next j End If Next i If p > 0 Then Ws.Range("C5").Resize(p, UBound(Temp, 2)).Value = Temp Application.ScreenUpdating = True End Sub Sub SS_Show() Subjects.Show End Sub استدعاء بيانات بطريقه الفورمه 99(5).xlsb

وفيك بارك اخى

@kkhalifa1960 @ابوخليل مشكورين جزاكم الله كل خير

تفضل عندما تفتح النموذج حرك ازرار التالي والسابق تجربة2.accdb

تم فصل الموضوع في المرات القادمة فضلا افرد كل استفسار بعنوان يخصه .............................................. بالنسبة لطلبك الثاني تم التعديل وتجده في المرفق المصاحب اما طلبك الاول فانت بحاجة الى الإلمام ببعض المفاهيم : 1- يلزم تقسيم قاعدة البيانات الى قاعدة تضم الجداول توضع على الخادم ، وواجهات توزع على المستخدمين 2- يجب تعيين الخاصية تأمين السجلات في جميع النماذج المحررة الى : سجل محرر ( record locks to Edited Record ) وهذه الخاصية تجدها في خصائص النموذج / لسان التبويب بيانات ... آخر خصيصة من الأسفل 3- الى هنا يمكن الكتابة من الجميع ولكن ليس في اللحظة نفسها .. حيث حينما يكون احد المستخدمين يكتب يظهر عند الآخر صورة قلم في زاوية النموذج العليا تدل على ان السجل يتم تحريره 4- لتجاوز هذه المشكلة يجب ان يكون النموذج غير منضم الى الجدول ويتم الحاق البيانات بواسطة الكود vba آمل ان تجد في هذه الاسطر القليلة الفائدة المرجوة . MRN_DataBase2.rar

بارك الله فيك هذا هو المطلوب ....... واسف على تعب حضرتك وصبرك معي

ممكن توضيح ما هي طريقة البحث المطلوبة

أعزائي أعضاء وزوار هذ المنتدى المميز نختم هذا الموضوع كما وعدتكم بالنسخة الاحترافية بأكواد VBA ماذا في هذه النسخة: في كل مرة تفتح البرنامج يحفظ لك صورة من التقويم عن الضغط على أي يوم تظهر لك رسالة معلومات عن اليوم وخيار بإضافة موعد لهذا اليوم في صفحة حول تستطيع التحكم في الصورة التي تظهر عن فتح البرنامج كيف تضع الصورة خلفية لسطح المكتب؟ اضغط على الصورة بزر الفأرة الأيمن اختر تعيين كخلفية لسطح المكتب التقويم الدراسي والمواعيدVBA.xlsm

اتفضل الحل فى الاستعلام ملاحظة الرقم 3 فى Space(3) هو عدد المسافات يمكن تغييره لما تريد Test.accdb

لوضع مسافات في الحقول ساتحدث عن طريقتين بدون اكواد ادخل على عرض التصميم للتقرير حدد الحقول المطلوبه ثم التبويب تنسيق ثم في خانة هامش ايمن ضع رقم 0.100سم او اكثر وفقا لما تريد بالزيادة او النقص الطريقة الثانية في حدث عند التحميل للتقرير ضع Me.tx.RightMargin = 100 tx هو اسم الحقل الرقم 100 ممكن زيلدته لزيادة المسافة وممكن انقاصه ايضل ممكن ايضا وضع الكود في حدث عن التنسيق ولكن سوف يظهر التأثير للكود فقط عند عرض التقرير في وضع معاينة قبل الطباعة قد تكون هناك طرق اسهل ولكن اخوك مجرد مزارع ولديه معلومات بسيطة في قواعد البيانات شايب

نزولا عند طلب بعض الأخوة بعرض معلومات أكثر عند تحديد يوم من التقويم و الضغط على F9 من لوحة المفاتيح فقد تم في المرفق: إضافة الأسماء الدارجة للمنازل والأنواء. في الإصدار السابق لا يمكن التعرف على النطاق الملون إلا من خلال أول وآخر خلية أما هذا الإصدار فيمكن التعرف من أي خلية. والعديد من الإضافات مع F9 مثل نهاية الأسبوع واليوم الحالي ‏‏التقويم الدراسي والمواعيد - وتنظيم الأعمال والمشاريع.xlsx

تفضل هنا يتم تحويل التقرير الى ملف pdf ويتم ارساله sendwatsWeb3.rar

هل هذا هو المطلوب ؟ 002- ترحيل بيانات بثلاث شروط.rar

الطريقة بالترخيص الأصلي فقط