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

السلام عليكم تكثر الحاجة الى اخراج تقرير حسب حقول محددة يختارها المستخدم وهذا الباب تم التطرق اليه في هذا المنتدى ومن يبحث يجد الكثير .. علما اني قد استفدت واخذت من تلك المواضيع فما انا الا ناقل . ورب ناقل علم الى من هو اعلم منه . وحتى يكون هذا الموضوع مرجع مختصر لكيفية تصميم واعداد التقرير لذا عملت على اعداد مثال صغير وهو عبارة عن جدول ونموذج وتقرير اولا : عمل قائمة في النموذج يتم فيها عرض حقول الجدول عند تحميل النموذج ... وهذه الاكواد هي المسؤولة : Private Sub Form_Load() Dim dbs As DAO.Database Dim tbl As DAO.TableDef Dim sCaption As String DoCmd.Restore Set dbs = CurrentDb Set tbl = dbs.TableDefs("table1") For Each fld In tbl.Fields sCaption = "" On Error Resume Next sCaption = fld.Properties("Caption") On Error GoTo 0 lstFields.AddItem fld.Name & ";" & sCaption Next fld Set dbs = Nothing Set tbl = Nothing End Sub ثانيا عملت زر لإعداد الحقول في التقرير ثم فتحه ، وخلف هذا الزر يتم تنفيذ هذه الشفرة Dim i As Integer Dim txt As TextBox Dim lbl As Label Dim intSelectedCount As Integer Dim lngWidth As LoadPictureConstants Dim intSelectedNo As Integer With lstFields If .ItemsSelected.Count = 0 Then MsgBox "يجب اختيار حقل واحد على الأقل", vbExclamation, "خطأ" Exit Sub End If DoCmd.OpenReport "Rep1", acViewDesign, , , acHidden intSelectedCount = .ItemsSelected.Count lngWidth = Reports("Rep1").Width / intSelectedCount Reports("Rep1").Section("PageHeaderSection").Height = 310 Reports!Rep1!Label2.Caption = Nz(Me.Textlabl) Reports("Rep1").Section("Detail").Height = 310 intSelectedNo = 0 For i = 0 To .ListCount - 1 If .Selected(i) Then Set lbl = CreateReportControl("Rep1", acLabel, acPageHeader, , , intSelectedNo * (lngWidth + 50), 5, lngWidth, 300) lbl.Caption = .Column(1, i) lbl.BackStyle = 1 lbl.BackColor = RGB(200, 200, 200) lbl.BorderStyle = 1 lbl.FontBold = True lbl.TextAlign = 2 Set txt = CreateReportControl("Rep1", acTextBox, acDetail, , .Column(0, i), intSelectedNo * (lngWidth + 50), 5, lngWidth, 300) txt.BorderStyle = 1 txt.TextAlign = 2 intSelectedNo = intSelectedNo + 1 End If Next i End With DoCmd.OpenReport "Rep1", acViewReport ملحوظات : جعلت زر الخروج في التقرير يغلق التقرير ( من غير حفظ ) متجاوزا رسالة تأكيد الحفظ حفظ التقرير يسبب تراكم الحقول المصنوعة داخل الكود .. ومن ثم تظهر المشكلات والأخطاء ختاما لا تنسوني من دعواتكم الصالحة واتمنى ان تجدوا فيه الفائدة والمتعة اختيار حقول التقرير.rar

تأكد من المكتبة الموجودة في الصورة

ربما غير واضح ويلزمه بعض التركيز 🤔😁 تفضل اخي جرب واي استفسار او اظافة لا تتردد في دكرها Sub GetPrice() Dim Lastrow&, Dest_Last&, Cpt&, DataRow&, WSDestRow&, i& Dim WSPrice As Worksheet, WSDest As Worksheet, WS As Worksheet Dim Clé As Object, dictKey As String, Price_list As String Dim srcRng As Range, KeyRng As Range, Dest_Rng As Range Dim Col As Variant, f As Variant, Réf As Variant Dim ShtDate As Date, MaxDate As Date With Application .EnableEvents = False .ScreenUpdating = False Set WSDest = Worksheets("itemout"): Price_list = WSDest.[B4].Value If Price_list = vbNullString Then: MsgBox "يجب عليك إدخال التاريخ", vbInformation: Exit Sub If Len(Price_list) > 0 Then If IsDate(WSDest.Range("B4").Value) Then For Each WS In Worksheets If IsDate(WS.Name) Then ShtDate = CDate(WS.Name) If ShtDate <= Price_list And ShtDate > MaxDate Then MaxDate = ShtDate End If Next WS If MaxDate = 0 Then MsgBox "قائمة الأسعار " & Price_list & _ vbCrLf & vbCrLf & "غير موجودة", _ vbInformation, "التحقق من قوائم الأسعار" Else On Error Resume Next Set WSPrice = Sheets(Format(MaxDate, "dd-m-yyyy")) With WSPrice DataRow = 5 Lastrow = .Range("D" & .Rows.Count).End(xlUp).Row Set srcRng = .Range(.Cells(DataRow, "D"), .Cells(Lastrow, "J")) Col = srcRng.Value2 End With With WSDest WSDestRow = 8 Dest_Last = .Range("B" & .Rows.Count).End(xlUp).Row Set KeyRng = .Range(.Cells(WSDestRow, "B"), .Cells(Dest_Last, "F")) f = KeyRng.Value2: Set Dest_Rng = .Cells(WSDestRow, "G") WSDest.[G8:G32] = Empty ReDim Réf(1 To UBound(f, 1), 1 To 1) End With Set Clé = CreateObject("Scripting.dictionary") For i = 1 To UBound(Col) dictKey = Col(i, 1) If Not Clé.exists(dictKey) And (dictKey) <> "" Then Clé(dictKey) = i End If Next i For i = 1 To UBound(f) dictKey = f(i, 1) If Clé.exists(dictKey) Then Cpt = Clé(dictKey) Réf(i, 1) = Col(Cpt, 7) End If Next i Dest_Rng.Resize(UBound(Réf, 1), UBound(Réf, 2)) = Réf End If End If End If .EnableEvents = True .ScreenUpdating = True End With MsgBox "تم جلب الأسعار من قائمة" & " " & WSPrice.Name & " " & "بنجاج", _ vbInformation, "التحقق من قوائم الأسعار" End Sub price list officena V2.xlsm

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

وبارك بك أخي الكريم ،

@Foksh اشكرك جزيل الشكر صديقي الغالي انا تعبتك معي ,, بارك الله بك وزادك علما وبارك الله في رزقك .🌹 تشرفت بك وارغب بالتواصل معك حتى ازعجك اكثر وازيد من صدماتك 🤣🤣

شكرا لك كثيرا هذا ما اريده 😀💗💯 قمت بتعديل الكود الحفظ اولاً وبعدين ترحيل البيانات DoCmd.RunCommand acCmdSaveRecord Dim strSQL As String strSQL = "INSERT INTO [اماكن العمل السابقه] (ID, Jop_Place, Date_Start) " & _ "SELECT الاسم.ID, الاسم.Jop_Place, الاسم.Date_Start " & _ "FROM الاسم " & _ "WHERE (((الاسم.ID)=[Forms]![الاسم]![ID]));" DoCmd.RunSQL strSQL بارك الله في جهودك معي عندي مشكله ثانيه في الموقع لا اعرف كيف اتواصل مع الاعضاء عند محاولة مراسله اي مشرف او خبير او عضو تظهر الرساله مع اني لم اقم بارسال رساله لاحد نهائيا هذه الرساله تظهر لي دائما وشكرا لك كثيرا

استبدل الكود في زر الحفظ بهذا الكود ، تم انشاء المتغير حسب طلبك . Private Sub ad_Click() On Error Resume Next If IsNull(Me.xc) Then MsgBox "الرجاء إدخال البيانات", vbCritical, "خطأ في الإدخال" Me.Undo Else Dim Date_P As Variant Date_P = dats.Value Dim Foksh As Variant Foksh = Date_P Me.da_d = Me.qqs Me.kk = 1 On Error Resume Next DoCmd.SetWarnings False DoCmd.RunCommand acCmdSaveRecord DoCmd.RefreshRecord DoCmd.OpenQuery "car_b", acViewNormal DoCmd.OpenQuery "car_c", acViewNormal DoCmd.OpenQuery "dell_subcar", acViewNormal DoCmd.OpenQuery "dman_rly", acViewNormal DoCmd.RunCommand acCmdSaveRecord MsgBox "تم حفظ السجل بنجاح", vbInformation, "نجاح العملية" Me.dats.Value = Format(DateAdd("d", 1, Date_P), "dd/mm/yyyy") DoCmd.Close DoCmd.OpenForm "enar_dman", acNormal Forms("enar_dman").Controls("dats").Value = Format(DateAdd("d", 1, Foksh), "dd/mm/yyyy") End If End Sub

وعليكم السلام ورحمة الله وبركاته ، جرب هذا التعديل أخي الكريم . طبعاً تم اجراء بعض التعديلات والإستغناء عن استعلام التحديث وتحويله إلى SQL في زر الحفظ ASD.accdb

تمام هيك 😅 ابشر ، بس خلني أخلص من الشغل

👀

العفو منك اخوي الغالي ، كل الاحترام لك يا صديقي

اضفت المطلوب فقط دون المساس بأي شيء . https://www.mediafire.com/file/fm1m8uh3vfss4le/samer-Test_2.rar/file

مشاركةً مع استاذ @Foksh تفضل أخي @Abdelaziz Osman محاولتي مع الشرح والمرفق . ووافني بالرد . DDTest1.rar

استاذ @سامر محمود تفضل طلبك . ووافني بالرد . https://www.mediafire.com/file/vhkqjziuwsbvbll/samer-Test-1.rar/file

كمثال ، جرب هذا الكود:- Private Sub value2_AfterUpdate() ' التأكد من أن القيمة في الحقل الأول (value1) ليست صفر If Nz(Me.value1, 0) <> 0 Then ' حساب النسبة المئوية وتحديث الحقل الثالث (percentage) Me.percentage = (Me.value2 / Me.value1) * 100 & " %" Else ' يمكنك تنفيذ إجراء آخر إذا كان الحقل الأول يحتوي على صفر أو لا يتم التعامل معه بشكل آخر End If End Sub

FILTER Add-ins.zip

حضرتك في بدابة الطريق ربما تفيدك هذه النتائج في عمل الجدول المدرسي Showing results for 'جدول الحصص' in content posted in منتدى الاكسيل Excel . - أوفيسنا (officena.net) بالتوفيق

قد لا يشعر بعضكم بالتعديل في إضافة صناديق التسميات في قسم رأس الصفحة، عليه بفتح تقرير rptReport2 في طور التصميم وحذف كل صناديق التسميات في قسم رأس الصفحة ثم حفظه، ثم تشغيل الإجراء AddReportPageHeaderLabels وإعادة فتح التقرير لمشاهدة نتيجة إضافة الصناديق. للإستفادة الكاملة من حدث الإضافة ينصح بإضافة التسميات في الخاصية Tag لصناديق قسم التفاصيل . أما من لا يريد استخدام هذا الإجراء ويرغب في إضافة التسميات بنفسه فينصح: بإضافة أسماء صناديق قسم التفاصيل في خاصية ControlTipText لصناديق قسم رأس الصفحة. أما بالنسبة للتقرير rptReport1 فقم بفتحه في طور التصميم وانظر إلى بعثرة صناديق التسميات في قسم رأس الصفحة، ثم أعد فتحه في طور التشغيل لمشاهدة الصناديق وقد صفت بشكل منظم. أعتقد أن هذا حل احترافي ويحتاج إلى عناية من المنتدى وكذلك العناية من أعضاء المنتدى ممن يستوعبون فكرته وجدواه.

مثل هذا الجهاز AT9000 ، ويعمل بنفس طريقة الجهاز CR100 بأته يأخذ كود MRZ ويفككه (وسيكون مشروعي التالي ان شاء الله 🙂 ) ، وبالاضافة يأخذ: صورة ملونة لصفحة الجواز ، صورة ابيض واسود لصفحة الجواز (لكشف التزوير) ، صورة من صورة صاحب الجواز الشخصية ، . . نعم يمكن التحكم في هذا ، بطريقتين: عن طريق ملف XML ، او بتفكيك السطر على اساس علامات "<" (لاحظ الوحدة النمطية في مشاركتي الأولى) ، او الاثنين معا 🙂 جعفر