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

طيب جرب المرفق حسب فهمي للموضوع <<<<<<<<<<>>>>>>>>>> اضفتا حقل ترقيم ... الخصم.accdb

تفضل حسب طلبك حقل في تذييل الصفحة يظهر رقم النسخة Dim i As Integer countPrint = 1 Do Until i = Me.[pallet order].Value i = i + 1 DoCmd.OpenReport "master card query", acViewNormal countPrint = countPrint + 1 Loop master card2.rar

تفضل اخي الكريم Dim i As Integer With Application.Forms For i = .Count - 1 To 0 Step -1 With .Item(i) If .Name <> "FXY" Then DoCmd.Close acForm, .Name End If End With Next i End With DoCmd.OpenForm "FXY" With Application.Reports For i = .Count - 1 To 0 Step -1 With .Item(i) DoCmd.Close acReport, .Name End With Next i End With تحياتي

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

Sub Test() Dim x, ws As Worksheet, sh As Worksheet, s As String, m As Long Application.ScreenUpdating = False Set ws = Worksheets(1) Set sh = Worksheets(2) sh.Range("B7:B" & Rows.Count).ClearContents s = sh.Range("AI3").Value If s = "" Then MsgBox "Select Grade First", vbExclamation: Exit Sub x = Application.Match(s, ws.Rows(1), 0) If IsError(x) Then MsgBox "No Data For This Grade", vbExclamation: Exit Sub m = ws.Cells(Rows.Count, x).End(xlUp).Row If m < 4 Then MsgBox "No Data", vbExclamation: Exit Sub sh.Range("B7").Resize(m - 3).Value = ws.Cells(4, x).Resize(m - 3).Value Application.ScreenUpdating = True End Sub

Sub Test() Dim ws As Worksheet, sh As Worksheet, n As Long, r As Long Application.ScreenUpdating = False Set ws = Worksheets(2) Set sh = Worksheets(3) n = sh.Cells(Rows.Count, 2).End(xlUp).Row + 1 For r = 8 To 13 If ws.Cells(r, 1).Value <> "" Then sh.Cells(n, 2).Resize(1, 3).Value = Array(ws.Range("D4").Value, ws.Range("H4").Value, ws.Range("D5").Value) sh.Cells(n, 5).Value = ws.Cells(r, 1).Value sh.Cells(n, 6).Resize(1, 3).Value = ws.Cells(r, 4).Resize(1, 3).Value sh.Cells(n, 9).Value = ws.Cells(r, 8).Value sh.Cells(n, 10).Value = ws.Range("C18").Value sh.Cells(n, 11).Value = ws.Range("C19").Value sh.Cells(n, 12).Value = ws.Range("A21").Value sh.Cells(n, 13).Value = ws.Range("D21").Value sh.Cells(n, 14).Value = ws.Range("F21").Value sh.Cells(n, 15).Value = ws.Range("H21").Value sh.Cells(n, 16).Value = ws.Range("I21").Value sh.Cells(n, 17).Value = ws.Range("C36").Value sh.Cells(n, 18).Value = ws.Range("C37").Value sh.Cells(n, 19).Value = ws.Range("I36").Value n = n + 1 End If Next r Application.ScreenUpdating = True End Sub

يمكنك استعمال هذا الكود وهو نفس الكود ولكن بتعديلات بسيطة Sub test() Dim ws As Worksheet, lr As Integer, lr2 As Integer Application.ScreenUpdating = False Sheets("البيان المجمع").Range("a4:e10000").ClearContents For Each ws In ThisWorkbook.Worksheets If ws.Name <> "البيان المجمع" And ws.Name <> "ملاحظات" Then With ws .Activate lr = .Cells(Rows.Count, 1).End(xlUp).Row lr2 = Sheets("البيان المجمع").Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets("البيان المجمع").Range("a" & lr2 & ":e" & lr2 + lr - 4).Value = .Range("a4:e" & lr).Value End With End If Next Sheets("البيان المجمع").Activate: Range("a1").Select Application.ScreenUpdating = True End Sub بالتوفيق

السلام عليكم يعد عرض البيانات المحدده فى الليست بوكس اريد ان اضيف التعديلات بعد الضغط علىه عملاء ج.rar

واياك استاذنا الفاضل ابا الحسن ... جزاك الله خيرا

ربنا يكرمك يارب ويديك الصحة والعافية ويزيدك من فضله استاذنا الكريم

😂ربي يعطيك الصحة والعافية

استاذنا / ومعلمنا / @kanory الله الله الله عليك سلمت يمينك هو المطلوب صبط معايا كل شئ وفى برنامجى الاساسى تعبتك معايا الله يكثر من امثالك ويجزاك كل خير ويعطيك الصحة والعافية وطول العمر

السلام عليكم احتاج اعرف طريقة حساب مدة العقد بالايام مثلا عندي مشروع تنفيذ طريق طريق مدته 24 شهر تبدأ من تاريخ 1443/01/01هـ كيف اعرف تاريخ الانتهاء وكم عدد الايام

طيب ... جرب الكود هذا <<<<<<<<<>>>>>>>>> DoCmd.RunCommand acCmdSaveRecord If Val(outs) <= Val(a) Then Me.a = [Forms]![Form1]![a] - [Forms]![Form1]![outs] ElseIf Val(outs) > Val(a) And Val(a) > 0 Then MsgBox "الرصيد الحالي لا يغطي التسديد" ElseIf Val(a) = 0 And Val(outs) <= Val(m) Then Me.m = [Forms]![Form1]![m] - [Forms]![Form1]![outs] ElseIf Val(outs) > Val(m) And Val(a) = 0 Then MsgBox "التسديد اكبر من رصيد اول المدة" End If

لإضافة 90 يوم على التاريخ المكتوب في مربع نص وليكن اسمه textbox1 مثلا ويتم وضع الناتج في textbox2 مثلا textbox2.value = Format(DateAdd("d", 90, cdate(textbox1.value)), "yyyy/mm/dd") ولطرح تاريخين نستعمل textbox3.value = DateDiff("d", cdate(textbox2.value), cdate(textbox5.value)) بالتوفيق

يجب أن تحول الصفر إلى واحد حتى تحافظ على قيمة الضرب يمكن استعمال هذه المعادلة =IF(G10="",1,G10)*IF(F10="",1,F10)*IF(H10="",1,H10)*IF(I10="",1,I10)*IF(J10="",1,J10) ولمن يعمل جهازه بنظام الفاصلة المنقوطة ولا يعرف كيف يغير الفاصلة إلى فاصلة منقوطة هكذا =IF(G10="";1;G10)*IF(F10="";1;F10)*IF(H10="";1;H10)*IF(I10="";1;I10)*IF(J10="";1;J10) بالتوفيق

أخي العزيز لايمكن اعطائك نصيحة في غير محلها مالم تحدد مجال اهتماماتك فلكل لغة برمجة مجال معين مخصصه له

وعليكم السلام لغة #C

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

تم التعديل لست بحاجة الى الزر .. فقط يتم عرض الحاضرين اليوم عن فتح النموذج خطوات التعديل : جعل مصدر بيانات النموذج استعلام يحتوي على معيار هو تاريخ اليوم Database2.accdb

قمت بضغط القاعدة وتم حل المشكلة شكرا

طيب جرب الحدث التالي <<<<<<<<>>>>>>>>> DoCmd.RunCommand acCmdSaveRecord If Me.outs <= Me.a Then DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE t1 SET t1.a = [Forms]![Form1]![a]-[forms]![Form1]![outs] WHERE (((t1.kan_id)=[Forms]![Form1]![kan]))" DoCmd.Requery DoCmd.SetWarnings True ElseIf Me.outs > Me.a And Me.a > 0 Then MsgBox "الرصيد الحالي لا يغطي التسديد" ElseIf Me.a = 0 And Me.outs <= Me.m Then DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE t1 SET t1.m = [forms]![Form1]![m]-[Forms]![Form1]![outs] WHERE (((t1.kan_id)=[Forms]![Form1]![kan]))" DoCmd.Requery DoCmd.SetWarnings True ElseIf Me.outs > Me.m And Me.a = 0 Then MsgBox "التسديد اكبر من رصيد اول المدة" End If اشكرك يا بشمهندس ........ منكم تعلمنا

القاعدة معطوبة انظر نتيجة الفحص ......

تفضل MyStore2.rar

تسلم استاذي الفاضل وجزاك كل خير بحاول ان شاء الله

شكرا من القلب للأستاذ/ محمد صالح

يكفي التعديل التالي Dim myWhere As String myWhere = myWhere & "iPage>3" myWhere = myWhere & " and YEAR = " & Me.Combo97 myWhere = myWhere & "and iBill_Number = '" & Me.txtsearch & "'" Me.Text20 = DSum("iAmount", "tbl_Items", myWhere) اما اذا اردت 3 فقط Dim myWhere As String myWhere = myWhere & "iPage=3" myWhere = myWhere & " and YEAR = " & Me.Combo97 myWhere = myWhere & "and iBill_Number = '" & Me.txtsearch & "'" Me.Text20 = DSum("iAmount", "tbl_Items", myWhere) تحياتي

الملف لا يحمل أي محاولة من حضرتك في تنفيذ المطلوب كما أن مطلوبك هكدا عمل برنامج متكامل يفضل أن تبدأ حضرتك في التنفيذ وإذا تعثرت في نقطة أو اثنتين يمكن عرضها في موضوع جديد مع شرح المطلوب بالتفصيل بالتوفيق

طيب <<<<<<<<>>>>>>>> اعمل زر وضع فيه هذا الحدث ............ Dim msgstyle Dim Rs As DAO.Recordset Dim Rs2 As DAO.Recordset Dim rstChild As Recordset Dim rstChild2 As Recordset Dim rstChild3 As Recordset Dim rstChild4 As Recordset Set Rs2 = CurrentDb.OpenRecordset("select * from proces where [id] Like '" & [id] & "*'") Set Rs = CurrentDb.OpenRecordset("local") Do While Not Rs2.EOF Rs.AddNew Set rstChild = Rs!vend.Value Set rstChild2 = Rs2!vend.Value Set rstChild3 = Rs!sisi.Value Set rstChild4 = Rs2!sisi.Value Rs!id_f = Rs2!id Do While Not rstChild2.EOF rstChild.AddNew rstChild.Fields(0) = rstChild2.Fields(0) rstChild.Update rstChild2.MoveNext Loop Do While Not rstChild4.EOF rstChild3.AddNew rstChild3.Fields(0) = rstChild4.Fields(0) rstChild3.Update rstChild4.MoveNext Loop Rs.Update Rs2.MoveNext Loop Set Rs = Nothing MsgBox Space(20) & "تمت العملية بنجاح.." & Space(20), msgstyle, "للمعلومية"

عليكم السلام إذا قمت بتسجيل ماكرو ستحصل على الكود وبقليل من التعديلات تجعل الكود متغيرا في صف الننهاية الذي رمزه LR هذا هو الكود Sub girlsfirst() Dim sh As Worksheet, lr As Long Set sh = ActiveWorkbook.Worksheets("sheet") lr = sh.Cells(Rows.Count, 3).End(3).Row With sh.Sort .SortFields.Clear .SortFields.Add2 Key:=Range("L10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add2 Key:=Range("C10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("B7:X" & lr) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub Sub boysfirst() Dim sh As Worksheet, lr As Long Set sh = ActiveWorkbook.Worksheets("sheet") lr = sh.Cells(Rows.Count, 3).End(3).Row With sh.Sort .SortFields.Clear .SortFields.Add2 Key:=Range("L10"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal .SortFields.Add2 Key:=Range("C10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("B7:X" & lr) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub بالتوفيق

السلام عليكم ورحمة الله وبركاته اخواني الكرام ابحث عن برنامج لادارة ورشات صيانة السيارات (الكراجات) لمن يمكنه المساعدة الرجاء التواصل معي وشكرا للجميع للتواصل على ايميل mhmd.hani@gmail.com

جزاك الله خيرا على تعبك ومتابعتك بالفعل هوه فعال مع الاصدارت التى تكرمت بذكرها لكنه فى الاول مكنتش فاهم الية عمله جزاك الله خيرا

السلام عليكم ياكرام بما انكم اساتذتا ، اتمنا منكم احد يرسل لي برنامج مكتب محامي قابل للتعديل عليه اكون شاكر لكم ابو رفاعي

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

من التبويب ادراج انقر على كائن ثم اختر نص من ملف ثم اختر ماتريد ادراجه والسلام

السلام عليكم قد شاركت سابقا في موضوع مشابه ولم أجد رابطه حيث قمت بوضع معادلة (حصلت عليها من النت) تقوم بما تريده وقد تم تطبيقها على ملفك بعد تعديل على إحداثيات نقاط البداية والوصول (باعتبار أن القيم كانت قيما نصية)... أرجو أن تفي الغرض المطلوب.... بن علية حاجي New.xlsx

برنامج اتحاد ملاك لمن يريد Owners Union.rar

سعيد جدا بتواصل الإخوة الأعزاء وشاكر لمروركم الكريم وبعد إذن أخي زياد علي بالنسبة للأخ الحبيب ياسر خليل يبدو أنه يوجد نقص في بعض ملفات الويندوز والأوفيس لديك ولعلاج ذلك فك الضغط عن الملف المرفق في المسار التالي C:\Program Files\Common Files\Microsoft Shared\Speech وبإذن الله ستجد كل شيء تمام Speech.rar

أخي الكريم يبدو أنك كتبت خارج النطاق الأصفر ولكن داخل النطاق المحدد في الكود A1:G25 وبالنسبة للصوت إنه يعمل منذ البداية ولكني أضفت سرعة الصوت وقمت بتقليلها إلى -5 حتى نتمكن من سماعها جيدا

ما شاء الله سعيد بتواصل الجميع في هذا الموضوع الرائع الإكسل والصوت وشاكر جدا لأخي زياد وأخي أبي عبد الله وإذا سمح لي الإخوة بإضافة بسيطة هي سرعة القراءة يمكنك تحديدها في الكود وكذلك تم حل مشكلة أخي سالم في عرض الصوت مرة واحدة عند كتابة رقم في الخلية التي تم تغييرها أكبر من 10 وإذا كان أصغر لا يصدر أي صوت وتحياتي للجميع الإعلام بالصوت-2.rar

شكرا لك أخي زياد ولكن النسخة الموجودة في الموقع الرسمي هي النسخة المفرغة أي ليس بها كتب وعند تحميل كل ما في الموقع من كتب سيصبح عدد الكتب 2000 كتاب تقريبا وهذا رابط في منتدانا العظيم لنسخة من المكتبة بها 6688 كتاب والجميل أنها برابط واحد مباشر يدعم الاستكمال

بالفعل أخي الكريم كما أخبر أخونا أبو البراء (الذي نفتقده كثيرا) يفضل إرفاق ملف

معلومة خفيفة وجميلة من أخ هو حبيب هو للأنس أب

الحمد لله الذي هدانا لهذا وإياك أخي الكريم

من خلال فهمي لبنية جداولك لا يلزمك تكرار حقول النشاط في الجدولين ويكفيك وضعها في الجدول الثاني وعرضها عن طريق استعلام يجمع بين الجدولين

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

نعم أخي يمكن ذلك عن طريق وضع هذا الكود في حدث عند تنشيط كتاب العمل Private Sub Workbook_Activate() Application.OnKey "{F1}", "MyProcedure" End Sub فقط استبدل f1 بأي مفتاح وظيفة آخر وكلمة myprocedure باسم الماكرو الذي تريد تنفيذه عند الضغط على هذا الزر ولمزيد من المعلومات http://msdn.microsoft.com/en-us/library/aa195807(office.11).aspx