كل الانشطه

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

للرفع

كل عام وأنت طيب أخي الكريم الفاضل ( خليفة ) وبخير وبصحة وعافية

أخي الحبيب الأستاذ الفاضل / @محمد هشام. السلام عليكم ورحمة الله وبركاته شكرا لكم وجزاكم الله خيرا ممكن أعرف كيفية عمل الصورة المتحركة في هذا التعليق ()

إلى أصحاب الفضل علينا؛ إلى من علمونا؛ وما زلنا نتعلم منهم منتدى أوفيسنا (Excle) الكرام الأستاذ الفاضل / @أ / محمد صالح الأستاذ الفاضل / @ابراهيم الحداد الأستاذ الفاضل / @Ali Mohamed Ali الأستاذ الفاضل / @عبدالله بشير عبدالله الأستاذ الفاضل / @محمد هشام. الأستاذ الفاضل / @Foksh السلام عليكم ورحمة الله وبركاته جميعا كل عام وأنتم جميعا بخير وصحة وسعادة بمناسبة عيد الأضحى المبارك أعاده الله عليكم وعلينا وعلى الأمة الإسلامية بالخير واليمن والبركات ملحوظة: (الأسماء مرتبة تصاعديا منذ أول رد علينا)

أخي الحبيب @kkhalifa1960 ، دائماً تذكُرنا بمناسباتنا ، فكل الشكر والتقدير لك ولشخصك الكريم . وتقبل الله منا ومنكم صالح الاعمال والطاعات ، وجعله في ميزان حسناتكم 🤗 . وكل عام وأنتم بخير جميعاً.

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

كل عام وجميع منتسبي منتدانا الغالي (أوفيسنا) بخير وصحة وعافية أعاده الله علينا وعليكم وعلى أمتنا الاسلامية بالخير واليمن والبركات.

أخي الفاضل المحترم الكريم زادك الله من علمه كل عام وانت طيب وبخير وبصحة جيدة وفي أحسن حال أخي المبجل ( foksh )

شكرا جزيلا وبارك الله فيك وأكثر الله من أمثالك

Data119.rar

أعتقد ان إستبدال هدا السطر سيوفي بالغرض من If xtbl > 0 Then Sh1.Range("A5").Resize(xtbl, 13).Value = Application.Index(v, Evaluate("ROW(1:" & xtbl & ")"), Evaluate("COLUMN(1:13)")) End If إلى If xtbl > 0 Then If xtbl = 1 Then Sh1.Range("A5").Resize(1, 13).Value = v Else Sh1.Range("A5").Resize(xtbl, 13).Value = v End If End If بطريقة مختلفة وأسرع نوعا ما Private Sub CommandButton1_Click() Dim i&, r&, c&, k&, t&, f&, xtbl&, lastRow&, n As Boolean, ok As Boolean, val$ Dim s, data, a(), ky(), tb(), j(), criteria() SetApp False ReDim ky(1 To MaxCombo): ReDim tb(1 To MaxCombo): ReDim j(1 To MaxCombo) For i = 1 To MaxCombo val = Trim(LCase(Me("ComboBox" & i).Value)) If val <> "" And val <> "*" Then ky(i) = val: n = True Else ky(i) = "" Next If Not n Then MsgBox "الرجاء تحديد معايير البحث", vbExclamation: GoTo CleanUp For i = 1 To MaxCombo If ky(i) <> "" Then f = f + 1: tb(f) = ColArr(i - 1): j(f) = ky(i) Next With Sh1 lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row If lastRow >= 5 Then .Range("A5:M" & lastRow).ClearContents End With data = OnRng: k = UBound(data, 1): t = 13 ReDim a(1 To k, 1 To t), criteria(1 To f) For r = 1 To k ok = True For i = 1 To f s = data(r, tb(i)) criteria(i) = IIf(IsDate(s), Format$(s, "yyyy/mm/dd"), LCase(Trim(CStr(s)))) If criteria(i) <> j(i) Then ok = False: Exit For Next If ok Then xtbl = xtbl + 1 For c = 1 To t: a(xtbl, c) = data(r, c): Next If IsDate(a(xtbl, 9)) Then a(xtbl, 8) = xDayName(Format(a(xtbl, 9), "dddd")) If IsDate(a(xtbl, 12)) Then a(xtbl, 11) = xDayName(Format(a(xtbl, 12), "dddd")) End If Next If xtbl > 0 Then Sh1.Range("A5").Resize(xtbl, t).Value = a AddBorders Sh1.Name CleanUp: SetApp True End Sub توحيد البحث في شيت واحد v7.xlsb

أخي الحبيب الأستاذ / @عبدالله بشير عبدالله أخي الحبيب الأستاذ / @محمد هشام.

تسلم ايديك

أخي الحبيب الأستاذ / @عبدالله بشير عبدالله السلام عليكم ورحم الله وبركاته عيد أضحى مبارك أعاده الله عليكم أعواما عديدة وأزمنة مديدة؛ وأنتم بخير وصحة وسعادة ما أجمل أن تدعو لأخيك بظهر الغيب؛ فما بالك إن كان الدعاء يوم عرفة؛ دعوت اليوم لكم بالاسم؛ حفظكم الله ورعاكم؛ وجزاكم الله خيرا. أخي الحبيب الأستاذ / @محمد هشام. السلام عليكم ورحم الله وبركاته عيد أضحى مبارك أعاده الله عليكم أعواما عديدة وأزمنة مديدة؛ وأنتم بخير وصحة وسعادة ما أجمل أن تدعو لأخيك بظهر الغيب؛ فما بالك إن كان الدعاء يوم عرفة؛ دعوت اليوم لكم بالاسم؛ حفظكم الله ورعاكم؛ وجزاكم الله خيرا. إليك الملف أخي الحبيب توحيد البحث في شيت واحد v6.xlsb

السلام عليكم عيدكم مبارك وايامكم سعيدة ان شاء الله. كان الطلب: نريد التصوير ، وتقطيع الصورة من خلال نموذج اكسس ، والجواب كان "استوديوهات مسقط" ، بكل ما للاستوديو من ادوات 🙂 اليكم الفيديو والدروس من هذا الرابط : . جعفر

السلام عليكم عيدكم مبارك وايامكم سعيدة ان شاء الله. كان الطلب: نريد التصوير ، وتقطيع الصورة من خلال نموذج اكسس ، والجواب كان "استوديوهات مسقط" ، بكل ما للاستوديو من ادوات 🙂 ستكون هناك سلسلة من الدروس التعليمية في كيفية التعامل مع الصور في الاكسس ، هنا في هذا الموضوع ، وحتى يكون الموضوع متسلسل في افكاره ، سيكون هذا الموضوع مغلق للتعليقات. اما التعليقات والاسئلة فستكون في الموضوع التالي ان شاء الله جعفر . والتصوير كان بهذه الكاميرات .

شكرا بارك الله فيك أستاذ وعيدكم مبارك مسبقا

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

وعليكم السلام ورحمة الله تعالى وبركاته اخي @AMIRBM تم تعديل الكود حسب طلبك ليعرض عمودين في ListBox داخل نموذج البحث مثلا (الإسم + التسلسل) يمكنك تعديله بما يناسبك وقد قمت بمحاولة تنقيحه وتحسينه ليكون أكثر كفاءة وتنظيما يرجى أولا تفريغ جميع الأكواد السابقة من النموذج ثم نسخ الكود التالي بالكامل Option Explicit Private ColArr As Variant Public Property Get WS() As Worksheet: Set WS = Sheets("add"): End Property Public Property Get dest() As Worksheet: Set dest = Sheets("search"): End Property Private Sub UserForm_Initialize() TextBox1.SetFocus 'قم بتحديد الأعمدة المرغوب عرضها ColArr = Array(2, 1) ' 2 = الإسم / 1 = التسلسل With ListBox1: .ColumnCount = UBound(ColArr) + 1: .ColumnWidths = "100pt;40pt": End With End Sub Private Sub TextBox1_Change() Dim c As Range, tmp As String, lastRow As Long, i As Long, listCount As Long ListBox1.Clear If IsEmpty(ColArr) Then Exit Sub tmp = Trim(TextBox1.Value) If Len(tmp) = 0 Then Exit Sub SetApp False lastRow = WS.Cells(WS.Rows.Count, ColArr(0)).End(xlUp).Row For Each c In WS.Range(WS.Cells(5, ColArr(0)), WS.Cells(lastRow, ColArr(0))) If InStr(1, c.Value, tmp, vbTextCompare) > 0 Then ListBox1.AddItem c.Value listCount = ListBox1.listCount For i = 1 To UBound(ColArr) ListBox1.List(listCount - 1, i) = c.EntireRow.Cells(1, ColArr(i)).Value Next i End If Next c SetApp True End Sub Private Sub CommandButton1_Click() Dim Irow As Long, f As Long, i As Long, xName As String, cnt As Boolean: cnt = False If ListBox1.listCount = 0 Then MsgBox "لا توجد نتائج للبحث", vbExclamation, "تنبيه": Exit Sub xName = Trim(TextBox1.Value): Irow = WS.Cells(WS.Rows.Count, ColArr(0)).End(xlUp).Row SetApp False For i = 5 To Irow If WS.Cells(i, ColArr(0)).Value = xName Then If Not cnt Then dest.Range("A8:L" & dest.Rows.Count).ClearContents f = dest.Cells(dest.Rows.Count, "A").End(xlUp).Row + 1 dest.Range("A" & f).Resize(1, 12).Value = WS.Cells(i, 2).Resize(1, 12).Value cnt = True End If Next i If Not cnt Then MsgBox "لم يتم العثور على الاسم" & xName & " ضمن كشف المرحليات", vbInformation, "نتيجة البحث" SetApp True: Unload Me End Sub Private Sub ListBox1_Click() TextBox1.Value = ListBox1.List(ListBox1.ListIndex, 0) End Sub Private Sub SetApp(ByVal enable As Boolean) On Error Resume Next With Application .ScreenUpdating = enable: .EnableEvents = enable: .DisplayAlerts = enable .Calculation = IIf(enable, xlCalculationAutomatic, xlCalculationManual) End With On Error GoTo 0 End Sub المرحليات أوفيسنا v2.xlsm

وعليكم السلام ورحمة الله وبركانه لم توضح ارتباط العمود الثاتي بأيعم ود في الشيت اليك التعديل Private Sub TextBox1_Change() ListBox1.Clear Application.ScreenUpdating = False Dim ws As Worksheet: Set ws = Sheets("add") Dim lr As Long, c As Range, b As Integer, k As Long Dim arrData() As Variant Dim i As Long, j As Long lr = 0 For Each c In ws.Range("b5:b" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row) b = InStr(1, c.Value, TextBox1.Value, vbTextCompare) If b > 0 Then lr = lr + 1 ReDim Preserve arrData(1 To 2, 1 To lr) arrData(1, lr) = c.Value arrData(2, lr) = c.Offset(0, 4).Value End If Next c With ListBox1 .ColumnCount = 2 .ColumnWidths = "100;100" If lr > 0 Then .List = Application.Transpose(arrData) End If End With Application.ScreenUpdating = True End Sub في الكود السابق تم ربط العمود الثاني باسم المعلم يمكنك التعديل يالتغيير في رقم 4 فهي تشير الى رقم العمود في الشيت بعد عمود الاسم arrData(2, lr) = c.Offset(0, 4).Value كنا يمكنك من تعديل عرض العمود بالتعديل في رقمي 100 الاول للعمود الاول والثانية للعمود الثاني .ColumnWidths = "100;100" ارجو ما قدمته ان يكون طلبك كل عام وانت بخير المرحليات أوفيسنا.xlsm

السلام عليكم ورحمة الله وبركاته تم تحسين سرعة الكود اي تغيير في I2 -13-14 يعمل الكود الترقيم التلقائي في العمود B تم تعديل المعادلة في العمود الاخير بحيت تظعر الارقام حيب اخر بيان في العمود C جرب الكود وان كان هناك أي استفسار فلا حرج اعاده الله عليك يالخير والبركة يومية النقدية 1العامة.xlsm

المشكلة الاساسية هي هذه فنحن لم نستطيع فتح اي نموذج او تقرير عموما من حيث المبدأ فتصدير التقرير الى الاكسل يتطلب استيفاء بعض الشروط فليس أي تقرير يمكن تصديره وحتى بعد التصدير لن تظهر جميع عناصره كما هي في التقرير مثال عنوان التقرير وكذا التسميات التوضيحية وغيرها من الاختلافات والطريقة الاسهل هي تصدير الاستعلام فهو أقرب مايكون الى ورقة أكسل قم بإعداد إستعلام يشمل جميع الأعمدة المطلوبة فعلى اعتبار ان الاستعلام المراد تصديره اسمه qryExportingData وتريد تصديرة الى نفس المجلد الخاص بالتطبيق بالإسم ExportingData.xlsx فبإستخدام الامر DoCmd.OutputTo acOutputQuery, "qryExportingData", acFormatXLSX, CurrentProject.path & "\ExportingData.xlsx", True, , , acExportQualityPrint سينتج لك ملف أكسل بنتيجة الإستعلام بنفس عناوين وترتيب الأعمدة

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

اهلا بحضرتك اسم التقرير Time Card by Employee and Date