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

تفضل استاذ @سامر محمود محاولتي الثانية افتح الفورم (UpDate_TableData) بالقاعدة vocations223) واختار مسار القاعدة (samer) ثم أكمل الباقي ووافني بالرد . ملحوظة : عند ادخال الباسوورد تأكد من لغة الكمبيوتر انجليزي . VACATIONS223.rar

مارديت أستاذ سامر .

العفو اخي يسعدنا اننا استطعنا مساعدتك

تمام بارك الله فيك وزادك علما

اخي ربما يتعين عليك وضع حماية لورقة العمل لديك لمنع اظهار الاعمدة او اخفائها بدون ادخال كلمة المرور جرب هدا الملف باسوورد 1234 إخفاء اعمدة وصفوف برقم سري.xlsb

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

Public Property Get WS() As Worksheet: Set WS = Feuil1 End Property Sub Hide_Columns() col = "F:G" On Error Resume Next WS.Columns(col).Hidden = True msg = InputBox("أدخل كلمة المرور", "كلمة المرور") If msg = "1234" Then WS.Columns(col).Hidden = False Else If MsgBox("كلمة المرور غير صحيحة، حاول مرة أخرى", Yes Or No, "كلمة مرور خاطئة") = Yes Then WS.Columns(col).Hidden = True On Error GoTo 0 End If End If End Sub '************************** Sub Hide_Rows() Xrows = "13:14" On Error Resume Next WS.Rows(Xrows).Hidden = True msg = InputBox("أدخل كلمة المرور", "كلمة المرور") If msg = "1234" Then WS.Rows(Xrows).Hidden = False Else If MsgBox("كلمة المرور غير صحيحة، حاول مرة أخرى", Yes Or No, "كلمة مرور خاطئة") = Yes Then WS.Rows(Xrows).Hidden = True On Error GoTo 0 End If End If End Sub إخفاء اعمدة وصفوف برقم سري.xlsb

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

مرحبا اساتذتنا الكرام يسرني المشاركة معكم في ايجاد حل للمطلوب رغم انني لم استوعب الفكرة جيدا وكنت قد صرفت النظر عن المشاركة في الموضوع لاكن بعد معاينة النتيجة المستخرجة على ملف الاستاد @AbuuAhmed الدي نكن له كل الاحترام والتقدير. اليك اخي هده المساهمة البسيطة على قدر ما استطعت فهمه لحد الساعة مع تغيير اسم الورقة المظافة من مصفوفة الى Test 🫣🫣 Sub test1() Dim wb As Workbook, WSdata As Worksheet, dest As Worksheet, lRow As Long, lCol As Long Set wb = ThisWorkbook: Set WSdata = wb.Sheets("الفواتير"): Set dest = wb.Sheets("Test") A = WSdata.Range("A2:I" & WSdata.[D65000].End(xlUp).Row) With Application .ScreenUpdating = False With dest Intersect(.Range(.Rows(2), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("A:I")).ClearContents End With Dim c(): ReDim c(1 To UBound(A, 1), 1 To 9) Cpt = 0 Set mondico = CreateObject("Scripting.Dictionary") For I = 1 To UBound(A) On Error Resume Next clé = A(I, 4) & A(I, 8) If Not mondico.exists(clé) Then Cpt = Cpt + 1: mondico.Add clé, Cpt: c(Cpt, 1) = clé: F = Cpt Else F = mondico.Item(clé) End If c(F, 1) = A(I, 1): c(F, 2) = A(I, 2): c(F, 3) = A(I, 3): c(F, 4) = A(I, 4): c(F, 5) = c(F, 5) + A(I, 5) c(F, 6) = c(F, 6) + A(I, 6): c(F, 7) = c(F, 7) + A(I, 7): c(F, 8) = A(I, 8): c(F, 9) = A(I, 9) Next dest.[a3].Resize(mondico.Count, UBound(c, 2)) = c lRow = dest.Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row With dest Union(dest.Range("A3:A" & lRow), dest.Range("F3:F" & lRow)).NumberFormat = "#,##0;- #,##0;""-""??" dest.Range("C3:C" & lRow).NumberFormat = "dddd dd-mm-yyyy" dest.Range("E3:E" & lRow).NumberFormat = "#,##0.0;- #,##0.0;""-""??" If dest.ListObjects.Count <> 0 Then Exit Sub lCol = .Cells(3, dest.Columns.Count).End(xlToLeft).Column dest.ListObjects.Add(xlSrcRange, .Range(dest.Cells(3, 1), .Cells(lRow, lCol)), , xlYes).Name = "Table1" .ListObjects("Table1").ShowAutoFilterDropDown = False End With On Error GoTo 0 .ScreenUpdating = True End With End Sub تجربة1.xlsb

تفضل أخي @jo_2010 🙂 هذا شكل الكود في الموديول : Public Sub PrintOut(pname As String, ID As Long) Screen.ActiveForm.Refresh If MsgBox("هل ... تريد طباعة التقرير الخاص بــ " & pname & " ؟ ", vbQuestion + vbMsgBoxRight + vbYesNo, Default_Title) = vbYes Then DoCmd.OpenReport "ss", acViewPreview, , "[id]=" & ID DoCmd.PrintOut DoCmd.Close acReport Else DoCmd.OpenReport "ss", acViewPreview, , "[id]=" & ID End If End Sub وتستدعيه بهذه الطريقة لأنه صار يستقبل معاملين هذه المرة ( الــ ID ، واسم الموظف ) Call PrintOut(pname.Value, Me.ID) Code.accdb

تفضل مرفقك أخي @Hamtoooo بعد تطبيق تعليمات معلمنا العود @ابوخليل 🙂 نفس الرسائل والأزرار .. وألق نظرة على محتويات الوحدة النمطية وكذلك جرب تغيير النصوص فيها ولاحظ الفرق في النموذج .. وهذا محتوى الوحدة النمطية : Option Compare Database Option Explicit Public Function Default_MSGBOX() 'الرسالة الموحدة MsgBox "هذه الرسالة موحدة", , Default_Title End Function Public Function Default_Title() As String ' العنوان الموحد Default_Title = "( اوفيسنا | الاصدار 3.8 )" End Function Public Function Default_Text() As String ' نص ثابت يكتب في الوحدة النمطية Default_Text = "هذا النص تم استدعائه من الوحدة نمطية" End Function Public Function DeleteBtn_Click() 'أمر عام يوضع على أزرار الحذف لحذف السجلات On Error GoTo Err_DeleteBtn_Click DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdDeleteRecord Exit_DeleteBtn_Click: Exit Function Err_DeleteBtn_Click: MsgBox Err.Description Resume Exit_DeleteBtn_Click End Function استدعاء الاكواد.accdb