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

السلام عليكم أخي أبو أحمد أولا نشكرك على جهودك المميزة ثانيا ، لم يحذف شييء فقط تم اخفاء الخطوات البينية قبل الوصول للحل تسهيلا على المتابعين حاليا و مستقبلا ، فأظن أننا نتفق أن كودك الاخير هو الافضل و الذي تم الابقاء عليه ظاهرا و اختير كافضل اجابة و الردود السابقة لم تحذف ، و هي موجودة يمكن استرجاعها اذا دعت الحاجة ـ و هذا الأمر يمكن بالطبع أن تكون فيه وجهات نظر مختلفة ، قد تكون محقا ككاتب للموضوع و بذلت جهد مشكور فيه تفضل الابقاء على كل المحاولات ، و من ناحية أخرى قد نكون كفريق عمل محقين فى الاباقاء على أفضل الحلول و الذي هو ايضا حلك تسهيلا على قراء الموضوع الحاليين و المستقبليين ، و لنعذر بعضنا بعضا فى نقاط الاختلاف حاليا الكود الافضل موجود و مختار :افضل اجابة و شكرا لك مقدما على تفهمك

العفو اخي @AMIRBM يسعدنا اننا استطعنا مساعدتك اليك هدا الاقتراح بطريقتي مع تحديث اسماء الشهور بدون الحاجة لوضعها في عمود مستقل Option Explicit Dim myFormat(1) As String Dim Arr As Variant Private Sub UserForm_Initialize() Dim OneRng(), i As Integer, n As Integer Dim f As Worksheet: Set f = Sheets("1") '<====' نطاق البيانات OneRng = f.Range("A3:F" & f.Range("B" & f.Rows.Count).End(xlUp).Row).Value ListBox1.List = OneRng cbxShtName.Value = f.Name With ListBox1 .ColumnCount = 6 .ColumnWidths = "60;170;140;90;90;90" .BorderStyle = fmBorderStyleSingle End With '<====' رؤوس الاعمدة For i = 1 To 6: Me("label" & i) = f.Cells(2, i): Next i End Sub '========================= Private Sub colRecherche(Tbl As Long, Cpt As Long) Dim cnt As Long, dict As Long cnt = UBound(Arr, 2) With ListBox1 .AddItem For dict = 1 To cnt .List(Tbl, dict - 1) = Arr(Cpt, dict) Next dict .List(Tbl, 1) = Format$(.List(Tbl, 1), _ "dddd, mmmm dd, yyyy") '<====' التاريخ .List(Tbl, 4) = Format$(.List(Tbl, 4), "0.00") '<====' مبلغ الوحدة .List(Tbl, 5) = Format$(.List(Tbl, 5), "0.00") '<====' المجموع End With End Sub '========================= Private Sub Filtre() Dim Cpt As Long, dict As Long, tmp As Long, cnt As Long, n As Long Dim Clé As Boolean, Réf As Boolean, sFilter As String Clé = Len(ComboBox1.Value) Réf = Len(tbxSearch) tmp = UBound(Arr, 1): cnt = UBound(Arr, 2) With Me.ListBox1 If .ListCount > 0 Then .RowSource = "" .Clear End If 'فلترة باسم الشهر If Clé Then sFilter = ComboBox1.Value For Cpt = 3 To tmp If Clé Then If Format(CDate(Arr(Cpt, 2)), "mmmm") Like sFilter Then colRecherche n, Cpt n = n + 1 End If Else colRecherche n, Cpt n = n + 1 End If Next Cpt If Réf Then 'فلترة باسم البضاعة sFilter = tbxSearch For n = .ListCount - 1 To 0 Step -1 If Not UCase(.List(n, 2) Like UCase("*" & sFilter & "*")) Then .RemoveItem (n) End If Next n End If End With Count.Caption = ListBox1.ListCount: SumColumns End Sub '========================= Private Sub cbxShtName_Change() Dim xMonth As Object 'اسماء الشهور المتوفرة Dim Cpt As Long, tmp As Long Dim WS As Worksheet: Set WS = Sheets("1") With WS.Range("A1:F" & WS.[B650000].End(xlUp).Row) Arr = .Value tmp = UBound(Arr, 1) Filtre Set xMonth = CreateObject("Scripting.Dictionary") xMonth("*") = "" For Cpt = 3 To tmp ' '<====' تنسيق اسم الشهر xMonth(Format(CDate(Arr(Cpt, 2)), "mmmm")) = Empty Next Cpt Me.ComboBox1.List = xMonth.keys End With End Sub '========================= Private Sub CommandButton1_Click() Dim WS As Worksheet: Set WS = Sheets("2") If ListBox1.ListCount = 0 Then: Exit Sub If MsgBox("ترحيل البيانات" & " ؟", vbYesNo) = vbNo Then Exit Sub WS.Range("B5:G" & WS.Rows.Count).ClearContents WS.[b5].Resize(Me.ListBox1.ListCount, 6) = Me.ListBox1.List End Sub تنسيق الشهر V2.xlsb

'الاستعلام عن حقل ان كان موجود If QForExport.b0 < 1 Then Beep MsgBox "الحقل المرد الاستعلام عنه(الوظيفة)غير موجود " Exit Sub End If الكود ده مش عاوز يشتعل معاايا فاين الخطا QForExport ده اسم الاستعلام b0 اسم الحقل

متشكر اولا علي سرعة الرد جزاكم الله خير ثانيا هو حقل واحد باسم b0 والتسمية بتاعته الوظيفة ولا يوجد اي حقول اخري في نفس الجدول او الاستعلام QForExport بهئا الاسم يعني عير مكرر الشء اللي ارغب في نوضيحة هو اني باختار من كمبوبوكس " معلم - معلم اول - معلم اول ا- معلم خبير- كبير معلمين " فاذاكان الحقل b0(الوظيفة) غير موجود بالاستعلام يعطي رسالة ان الحقل غير مضاف ويخرج من الاجراء لحين اضافة الحقل للاستعلام من listbox الاستاذ محمد احمد لطفي متشكر جدا علي ردك ولكن لم ينجح الامر وبيعطي رسالة موجوده فيNew Bitmap image.bmpNew Bitmap image.bmpNew Bitmap image.bmp المرفقات

هل نسطيع عند فتح النموذج يتم اظهار اسم المادة التي ت اختيارها

هل الاستعلام QForExport عبارة عن سجل واحد فقط ؟ اذا الجواب لا : بل يشتمل على سجلات عديدة اذا يوجد اكثر من حقل b0 داخل الاستعلام فأي حقل تريد الاستعلام عنه اتمنى يكون تساؤلي واضح بمعنى يلزم شرط محدد لاختيار وتحديد الحقل المقصود

برافوا عليك ياهندسة البرمجة اشتغلت الله ينور ومتشكر علي تعبك ومجهودك

أنا ( وأعوذ بالله من كلمة أنا ) ، لقيته في مديول عندي مع إلغاء جزئية الكسر العشري واستبدالها بالمطلوب 😂 وأدينا بنستنا الطفرة الجينية وإضافتها للمكتبة العامرة 😁

انت بتقلب فى المنتدى يا فؤش وتطلع المرفقات القديمة... عاااااش انتظروا قريبا جدا بأمر الله كدت انتهى من تحضير هدية قيمة بمعنى الكلمة إن شاء سوف تكون طفرة بمعنى الكلمة فى موضوع التفقيط وحصريا فى منتدانا الحبيب لن تجدوا لها مثيل الا فى المكتبة العامرة 😄 لانه وصل بالسلامة للمكتبة

اخي الكريم @ahmed_204079 هل يوجد شروط للنسخ من الحقل المصدر إلى الحقل الهدف ؟ إن كان لا ، فجرب هذا الكود Sub CopyData() Dim db As DAO.Database Dim rs As DAO.Recordset Dim strSQL As String Set db = CurrentDb strSQL = "SELECT * FROM DATA_TECH" Set rs = db.OpenRecordset(strSQL, dbOpenDynaset) rs.MoveFirst Do While Not rs.EOF If Not IsNull(rs!a1) Then rs.Edit rs!a6 = rs!a1 & "qena1.moe.edu.gov.eg@" rs.Update End If rs.MoveNext Loop rs.Close Set rs = Nothing Set db = Nothing MsgBox "تم نسخ البيانات وتحديث الحقل بنجاح", vbInformation End Sub وفي الزر Btn_Doit كمثال تستطيع استدعاء الدالة من خلال الإسم :- Private Sub Btn_Doit_Click() CopyData End Sub

السلام عليكم ورحمة الله السادة الخبراء والأعضاء الكرام بكل فخر أعلن باكورة تعاوني مع الخبير ذائع الصيت اخي الحبيب Foksh و أعتز بمساعدته الكبيرة في نجاح الفكرة حيث أنها اصبحت تعمل كبرنامج قائم بذاته وقد نالت هذه القاعدة اهتمامي لأنها قد تخدم في عدة مجالات بعد تطويرها مثل الشبكات و المصانع والمطاعم والكافيهات وصالات البلياردو. ولكم جزيل الشكر playstation 5.rar

أردت تجربة الملف المرفق ولكن ظهرت المشاكل التاليىة