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

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

مساهمة ثالثة مني إصافة إلى المساهمتين السابقتين لزميلاي. توزيع الطلاب_03.xlsm

الفكرة تم تطبيقها على ملف توزيع الطلاب.xlsb

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

وفيك بارك الله اخى محمد بالتاكيد اسمح اخى واستاذى العزيز حتى اتعلم وان شاء الله يكون ما يريد اخينا احمد واسمح لى بسؤال هل يمكن بدل علامات استفهام بوجود فواصل الاسطر بناء ع اسم المدرسه

هل ما قدمته لك مناسب ؟ انت عرضت علي في اكسل ثلاث جداول او حالات .. الدائن والمدين والرصيد وانا جعلتها لك في سطر واحد التجميع يتم حسب الحساب والمتجر

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

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

بارك الله في اخي واستاذي @أبوبسمله لو تسمح لي بالمشاركة ... اخي @ahmed_204079 انظر لصورة التقرير التالي واماكن علامات الاستفهام ودقق بها اذا كان التقرير مناسب لك بهذه الطريقة سوف ادرج لك المرفق ..........

تفضل هذه الدالة في وحدة نمطية عامة من اجل تأخذ القيمة من الجدول بناء على المتغير getPrintOrPdf قيمة هذا المتغير تأخذ 1 أو 2 وقت النقر على الازرار .. زر الطباعة =1 وزر البي دي اف =2 Public getPrintOrPdf As Byte Public Function funReportPrintOrPdf() As Byte Dim prntNon, prntWrd, prntPic, pdfNon, pdfWrd, pdfPic prntNon = DLookup("Non", "Reportsettings_tbl") prntWrd = DLookup("Words", "Reportsettings_tbl") prntPic = DLookup("Photo", "Reportsettings_tbl") pdfNon = DLookup("NotHDFot", "Reportsettings_tbl") pdfWrd = DLookup("WORDPDF", "Reportsettings_tbl") pdfPic = DLookup("IMAGEPDF", "Reportsettings_tbl") If getPrintOrPdf = 1 Then If prntNon = True Then funReportPrintOrPdf = 1 If prntWrd = True Then funReportPrintOrPdf = 2 If prntPic = True Then funReportPrintOrPdf = 3 ElseIf getPrintOrPdf = 2 Then If pdfNon = True Then funReportPrintOrPdf = 1 If pdfWrd = True Then funReportPrintOrPdf = 2 If pdfPic = True Then funReportPrintOrPdf = 3 End If End Function وهذه الاكواد في محرر التقرير اخفاء الرأس والذيل في حدث فتح التقرير والتحكم في النص والصورة في حدث الطباعة للرأس والذيل Private Sub PageFooterSection_Print(Cancel As Integer, PrintCount As Integer) If funReportPrintOrPdf = 2 Then Me.HRA2.Visible = True Me.HLA2.Visible = True Me.footerimage.Visible = False ElseIf funReportPrintOrPdf = 3 Then Me.HRA2.Visible = False Me.HLA2.Visible = False Me.footerimage.Visible = True End If End Sub Private Sub PageHeaderSection_Print(Cancel As Integer, PrintCount As Integer) If funReportPrintOrPdf = 2 Then Me.HRA.Visible = True Me.HLA.Visible = True Me.Headerimage.Visible = False ElseIf funReportPrintOrPdf = 3 Then Me.HRA.Visible = False Me.HLA.Visible = False Me.Headerimage.Visible = True End If End Sub Private Sub Report_Open(Cancel As Integer) Call funReportPrintOrPdf If funReportPrintOrPdf = 1 Then Me.PageHeaderSection.Visible = False Me.PageFooterSection.Visible = False Else Me.PageHeaderSection.Visible = True Me.PageFooterSection.Visible = True End If End Sub NEW_Hedar2.rar

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

تسلم يا عبقري يا فنان

وعليكم السلام ورحمة الله وبركاته اضغط زر بحث يمكنك الاختيار من القائمة ثم زر اظافة او الكتابة في المستطيل الاصفر وتتم الفلترة للاسماء سواء الاسم او اسم الاب او اللقب تم زر اظافة محرك بحث - قائمة منسدلة.xlsb

لم يتم اخي الفاضل اظافة الكود انا في انتظار الرد على سؤالي ما هي طريقة ترحيل المشتريات هل سيتم النسخ الى صفحات المخازن وورقة المشتريات دفعة واحدة مع تحديث الكود او مادا على العموم على حسب ما فهمت الى غاية اللحظة ربما هدا ما تحاول فعله Sub TransferData2() Dim i As Long, Cnt As Long Dim ws As Worksheet, f As Worksheet, sWS As Worksheet Dim Sh As String, arr As Variant Dim tbl As ListObject, a As Range, lige As Range Dim j As String, newCode As String, b As String Set ws = ThisWorkbook.Sheets("تسجيل") Sh = ws.[G3].Value arr = Array(ws.[G4], ws.[G5], ws.[G6], ws.[G7]) For i = 0 To 3 If arr(i) = "" Then MsgBox "يرجى إدخال: " & arr(i).Offset(0, -1), vbExclamation, "إنتباه" ws.Activate: arr(i).Select Exit Sub End If Next On Error Resume Next Set f = ThisWorkbook.Sheets(Sh) On Error GoTo 0 If f Is Nothing Then MsgBox "قائمة المخزون " & Sh & " غير موجودة", vbExclamation Exit Sub End If If MsgBox("هل ترغب في ترحيل بيانات التسجيل؟", vbYesNo + vbQuestion, "تأكيد الترحيل") = vbNo Then Exit Sub Set tbl = f.ListObjects(1) On Error Resume Next Set lige = tbl.ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeConstants).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious) On Error GoTo 0 ' الكود الجديد If Not lige Is Nothing Then j = lige.Value b = Left(j, Len(j) - Len(CStr(Val(j)))) Cnt = Val(Right(j, Len(j) - Len(b))) newCode = b & Cnt + 1 Else newCode = ws.[G4].Value End If If Not lige Is Nothing Then Set a = lige.Offset(1, 0) Else Set a = tbl.ListColumns(2).DataBodyRange.Cells(1, 1) If a.Value <> "" Then Set a = tbl.ListColumns(2).DataBodyRange.Cells(tbl.ListRows.Count + 1, 1) End If End If a.Value = newCode ' الكود a.Offset(0, 5).Value = 1 ' الكمية a.Offset(0, 2).Value = arr(1) ' الاسم a.Offset(0, 3).Value = arr(2) ' الوصف a.Offset(0, 7).Value = arr(3) ' الملاحظات a.Offset(0, 9).Value = Format(Date, "dd/mmmm") ' التاريخ Set sWS = Sheets("المشتريات") Set tbl = sWS.ListObjects(1) On Error Resume Next Set lige = tbl.ListColumns(3).Range.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious) On Error GoTo 0 If Not lige Is Nothing Then Set a = lige.Offset(1, 0) Else Set a = tbl.ListColumns(3).DataBodyRange.Cells(1, 1) If a.Value <> "" Then Set a = tbl.ListColumns(3).DataBodyRange.Cells(tbl.ListRows.Count + 1, 1) End If End If a.Cells(1, 1).Offset(0, -1).Value = Format(Date, "dd/mmmm") ' التاريخ a.Value = newCode ' الكود a.Offset(0, 5).Value = 1 ' الكمية a.Offset(0, 2).Value = arr(1) ' الاسم a.Offset(0, 3).Value = arr(2) ' الوصف a.Offset(0, 7).Value = arr(3) ' الملاحظات a.Offset(0, 9).Value = Format(Date, "dd/mmmm") ' التاريخ End Sub مبيعات ومشتريات V1.xlsb

السلام عليكم ورحمة الله و بركاته كيف يمكن تشغيل استعلام الحذف من خلال زر الحذف من النموذج عن طريق الكود وجزاكم الله خيرا testcopy.mdb

تفضل testcopy.mdb

1- DoCmd.SetWarnings False DoCmd.OpenQuery "Dell" DoCmd.SetWarnings True

وعليكم السلام Dim i As Boolean i = Forms!FORMS_101!FARY_ADD!CK_1 If i = True Then DoCmd.OpenReport "REBORT_101", acViewPreview Else DoCmd.OpenReport "REBORT_102", acViewPreview End If 334.mdb

ست! راجل وكمان تشوف عيوني بتشوف النور ده اصلي 😂 استاذ @Moosak ❤️🌹 الاكواد وتصفيف من ايديك غير واحلا الكيك ينوكل من ايد صنيعي اما انا وين محترفه! جبت العيد بالمرفقك موضح بعض الفكره وطبعا انا مستأذنة منه بستخدام مرافقاته تحميل وتجربة https://www.mediafire.com/file/0ic3il3u6siwvuw/list+menu+moosack.rar/file