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

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

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

تفضل- تم عمل معادلة جلب جميع الأصناف المدخلة في الشيت الإجمالى.xlsm التفصيلى.xlsx

تفضل دالة نقل بيانات.xlsm

بارك الله فيك استاذ . @ازهر عبد العزيز مسافر حتى الان اجيب من الموبايل .... أشكرك ...

وعليكم السلام-بارك الله فيك وجزاك الله كل خير

اهلا بك في المنتدى تفضل الإجمالى.xlsm التفصيلى.xlsx

وعليكم السلام-لك ما طلبت توزيع.xlsm

وعليكم السلام-كان عليك من البداية استخدام خاصية البحث فى المنتدى-فهنا العديد من الموضوعات التى تخص طلبك ومنها : https://www.officena.net/ib/topic/29892-توزيع-الأقساط-و-متابعة-سدادها-بـ-excel/?tab=comments#comment-148900 https://www.officena.net/ib/topic/89374-برنامج-تسجيل-الاقساط-بشكل-اوتوماتيك-اهداء-لكم/?tab=comments#comment-577703 https://www.officena.net/ib/topic/60753-برنامج-لإدارة-الأقساط/?tab=comments#comment-390838 https://www.officena.net/ib/topic/69314-معادلة-احتساب-عدد-الاقساط-مرتبط-بالمبلغ-المستحق-الكلي/?tab=comments#comment-451242 https://www.officena.net/ib/topic/69787-برنامج-العطاء-للتقسيط-الخامس-المجاني-قريبا/?tab=comments#comment-453851 https://www.officena.net/ib/topic/13020-برنامج-التقسيط-للأفراد-والمؤسسات/?tab=comments#comment-55880 https://www.officena.net/ib/topic/89184-برنامج-الاول-للاقساط/

ومن اين يتم جلب تواريخ هذه المناسبات -لابد من معرفتها مسبقا ووضعها فى الملف ؟!!!

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

وهذه النتيجة النهائية بفضل الله تعالى ثم فضل استاذى الجليل ومعلمى القدير و والدى الجبيب الاستاذ @jjafferr وتدلل يا استاذ @Barna وهى بضاعتكم نردها ونعبدها اليكم بحلتها الجديدة تم التعديل على الاكواد لاختزالها Barna ( Export to Word ).accdb

اتفضل - تم حمل ملف الورد داخل القاعدة يمكن تغييره حسبما يناسبك - يتم عمل تحميل الملف اليا دون ادنى تدخل من المستخدم - تم اختزال الأكواد بطريقة ولا اروع أتوجه بكل الشكر والتقدير والعرفان بالجميل لاستاذى الجليل و معلمى القدير وملهمى و والدى الحبيب الاستاذ @jjafferr بفضل الله تعالى ثم استاذى تم حل مشكلة الدوران على كل السجلات لتصدير بياناتهم دفعة واحدة للاستاذ jjafferr Export to Word.accdb

وعليكم السلام -بارك الله فيك أستاذ سليم وزادك الله من فضله وهذا حل اخر بمعادلات المصفوفة لإثراء الموضوع بحث فى جدول.xlsx

جرب هذا الماكرو Option Explicit Rem =====>> created by Salim Hasbaya 13/7/2019 Sub Get_Data_Please() '========================== Dim Source_Sh As Worksheet Dim Target_Sh As Worksheet Dim LRS%, LRT%, RG_S As Range, RG_T As Range Dim cel As Range, My_adrs As Range '========================== Set Source_Sh = Sheets("DATA") Set Target_Sh = Sheets("TAB") LRS = Source_Sh.Cells(Rows.Count, 2).End(3).Row LRT = Target_Sh.Cells(Rows.Count, 3).End(3).Row Set RG_S = Source_Sh.Range("b3:M" & LRS) Set RG_T = Target_Sh.Range("C4:E" & LRT) Target_Sh.Range("F4:H" & LRT).ClearContents On Error Resume Next For Each cel In RG_T On Error Resume Next Set My_adrs = RG_S.Find(cel, lookat:=1) On Error GoTo 0 If Not My_adrs Is Nothing Then cel.Offset(, 3) = Source_Sh.Cells(My_adrs.Row, 2) End If Next End Sub الملف مرفق ب جدول - Copy.xlsm

تفضل يا سيدي 🙂 Private Sub BtnAllRcrd_Click() 'On Error GoTo ErrHandler On Error Resume Next Dim rs As DAO.Recordset Dim LWordDoc As Object Set LWordDoc = CreateObject("Word.Application") Set rs = CurrentDb.OpenRecordset("Table1") If Not rs.EOF Then rs.MoveFirst Do Until rs.EOF LWordDocOriginal = CurrentProject.Path & "\WordDoc.Doc" ' LWordDocSaveAs = CurrentProject.Path & "\" & rs!Fullname & "_Doc.Doc" ' FileCopy LWordDocOriginal, LWordDocSaveAs ' LWordDoc.Documents.Open CurrentProject.Path & "\" & rs!Fullname & "_Doc.Doc" LWordDoc.Documents.Open LWordDocOriginal LWordDoc.Visible = False LWordDoc.ActiveDocument.Bookmarks("fname").Select LWordDoc.Selection.InsertAfter Nz(rs!Fullname.Value, "") LWordDoc.ActiveDocument.Bookmarks("Civ").Select LWordDoc.Selection.InsertAfter Nz(rs!CivilNo.Value, "") LWordDoc.ActiveDocument.Bookmarks("Nat").Select LWordDoc.Selection.InsertAfter Nz(rs!Nationality.Value, "") LWordDoc.ActiveDocument.Bookmarks("Rate").Select LWordDoc.Selection.InsertAfter Nz(rs!Rate.Value, "") LWordDoc.ActiveDocument.Bookmarks("Chin").Select LWordDoc.Selection.InsertAfter Nz(rs!CheckIn.Value, "") LWordDoc.ActiveDocument.Bookmarks("Chout").Select LWordDoc.Selection.InsertAfter Nz(rs!CheckOut.Value, "") LWordDoc.ActiveDocument.Bookmarks("Pr").Select LWordDoc.Selection.InsertAfter Nz(rs!Price.Value, "") LWordDoc.ActiveDocument.SaveAs (CurrentProject.Path & "\" & rs!Fullname & "_Doc.Doc") rs.MoveNext Loop 'LWordDoc.Application.Documents(rs!Fullname & "_Doc.Doc").Save 'LWordDoc.Quit 'LWordDoc.ActiveDocument.SaveAs (rs!Fullname & "_Doc.Doc") LWordDoc.Quit Set LWordDoc = Nothing 'ErrHandler: ' If Err.Number = 3021 Then Resume Next End Sub جعفر

اعجبني وما بعرف مين صممه حكمة اليوم.accdb

ما ادري شو معني كلامك ؟ نحن نشجع البحث في المواضيع القديمة ، والبحث عن اجابات حديثة تحتاج الى من يرد عليها ، من الاعضاء المتواجدين في المنتدى الآن 🙂 ولكن لا ضمان من وجود الاعضاء القدامى اصحاب المواضيع القدامى ، للرد على سؤالك. جعفر

شغلت البرنامج الأن ويعمل معي .... انظر Dim X As Object On Error Resume Next Set X = CreateObject("Word.Application") X.Documents.Open CurrentProject.Path & "\المتضررين.Docx" X.Visible = True X.Activate X.ActiveDocument.Bookmarks("المعرف").Select X.Selection.InsertAfter Me.s1 X.ActiveDocument.Bookmarks("الاسم").Select X.Selection.InsertAfter Me.s2.Value X.ActiveDocument.Bookmarks("العنوان").Select X.Selection.InsertAfter Me.s3.Value X.ActiveDocument.Bookmarks("رقم_الهاتف").Select X.Selection.InsertAfter Me.s5.Value هذا هو الكود ..... طبق الشرح على ملف لديك .... يجب أن تكون القاعدة وملف الوورد في نقس المكان

تابع الشرح ..... قبل الشرح أود التأكيد على نقطة عند كتابة المسميات أكتبها بالانجليزي ومتلاصق مثل Fullname أو Full_name بالصور : هل استطعت فتح الملف ؟؟؟؟؟؟

امكن المشكلة من ملف الضغط لديك غير محدث .... لكن تفضل الملفين بدون ضفغط المتضررين.docx بيانات.accdb

وعليكم السلام .... فتح القاعدة أم ملف الضغط

استبدل هذا السطر في الكود R1 = RG_Source.Columns(1).Find(Target_sh.Range("D7")).Row بهذا R1 = RG_Source.Columns(1).Find(Target_sh.Range("D7"),Lookat:=Xlwhole).Row Xlwhole هنا حرف الـــ L باللغة الانكليزية وليس رقم 1 اذا كان هذا الجواب الكود يفي بالغرض اضغط على افضل اجابة لإغلاق الموضوع

انظر المرفق ..... تطبيق.rar

انا اقصد المرفق الموجود في بداية الموضوع أخي هل أعمل على التعديل عليه وأنت تنقله لملفك الخاص ؟؟؟؟

هل النموذج الموجود في بداية الموضوع يمثل نموذجك الحقيقي ...... حتي احاول العمل عليه

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

تم ازالة بعض الخلايا المدمجة لحسن عمل الكود مجرد ان تدخل الاسم او الرقم يقوم الكود بعمله واذا كان هناك خطأ يعطيك اشعاراً بذلك الكود Option Explicit Private source_sh As Worksheet Private Target_sh As Worksheet Private Last_row% Private RG_Source As Range Private R1% Rem =====>> created by Salim Hasbaya 13/7/2019 Sub Get_Data_By_name() Set source_sh = Sheets("ورقة2") Set Target_sh = Sheets("ورقة1") Union(Target_sh.Range("D8"), Range("c12").Resize(, 5)).ClearContents Last_row = Application.Max(source_sh.Range("D:D")) + 6 Set RG_Source = source_sh.Range("b6:d" & Last_row) On Error Resume Next R1 = RG_Source.Columns(1).Find(Target_sh.Range("D7")).Row On Error GoTo 0 If R1 = 0 Then MsgBox "DATA nOT FOUND": Exit Sub Else With Target_sh .Range("C12") = .Range("D7") .Range("D8") = source_sh.Cells(R1, "C") .Range("F12") = .Range("D8") .Range("G12") = source_sh.Cells(R1, "D") End With End If End Sub Rem ------------------------------------------- Sub Get_Data_By_Index() Set source_sh = Sheets("ورقة2") Set Target_sh = Sheets("ورقة1") Union(Target_sh.Range("D7"), Range("c12").Resize(, 5)).ClearContents Last_row = Application.Max(source_sh.Range("D:D")) + 6 Set RG_Source = source_sh.Range("b6:d" & Last_row) On Error Resume Next R1 = RG_Source.Columns(2).Find(Target_sh.Range("D8"), lookat:=xlWhole).Row On Error GoTo 0 If R1 = 0 Then MsgBox "DATA NOT FOUND": Exit Sub Else With Target_sh .Range("D7") = source_sh.Cells(R1, "B") .Range("C12") = .Range("D7") .Range("F12") = .Range("D8") .Range("G12") = source_sh.Cells(R1, "D") End With End If End Sub Rem +++++++++++++++++++++++++++++ Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Count = 1 Then Select Case Target.Address Case "$D$7": Get_Data_By_name Case "$D$8": Get_Data_By_Index End Select End If Application.EnableEvents = True End Sub Archive2019.xlsm

اتفضل اخى الحبيب الملف لعله يفى بالغرض ولكن بتعديل بسيط فى الشيت حتى يكون البحث بالاسم او بالرقم من خلال خلية واحدة نسخة من ارشيف2019.xlsx

جرب هذا الملف اعتذر عن ادراج الماكرو بسبب البطء الشديد للنت AUTO_SHOW_HIDE.xlsm

جرب هذا الماكرو Option Explicit Sub Verify_data() With Sheets("ورقة1") Dim my_rg As Range Dim i% Set my_rg = Range("A2", Range("M1").End(4)) For i = 1 To my_rg.Rows.Count If my_rg.Cells(i, 2) = False Then _ my_rg.Cells(i, 7).Resize(, 7) = 0 Next End With End Sub الملف مرفق tajriba.xlsm

وعليكم السلام-اهلا بك فى المنتدى لابد من رفع ملف وشرح المطلوب عليه بكل دقة حتى تتم المساعدة

وهو ده بالفعل الموجود بالملف

يمكنك وضع السطر الأول في بداية الكود الذى يسبب اهتزاز الشاشة والسطر الأخر في نهاية نفس الكود

تفضل لك ما طلبت عدد الأيام المتبقية على المناسبات.xlsm

السلام عليكم اتمنى اللي عنده برنامج جاهز مجاني يشاركه هنا معنا لكي يستفيد الجميع مخازن - مشتريات - مبيعات - عملاء - موردين - قبض - صرف - كشوفات حساب جزاكم الله خيرا اساهم معكم بأول برنامج برنامج المحل.rar

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

شكراً أ @qathi علي مشاركتك وتضامنك ولا أعلم ما الإشكال في الطلب حتي لا أجد رداً مناسباً ولو بالتوجيه وأتضامن معك في طلبك

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

نعم يمكنك نقل ازار التحكم الى نماذجك طبعا لازم تكون الوحدات النمطية موجود في برنامجك ولازم اضافة أسماء النماذج بالجدول Frm Ability لم يستجد أي جديد ::بالتوفيق::

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

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

استاذي الفاضل عبداللطيف سلوم بارك الله بجهودك يا طيب ربنا معاك في كل خطوة اذا امكن البرنامج باصدار 2003 اكون ممنون منك يا طيب

بالحقيقة ليس لي اطلاع بالسيكوال ..لكن لا بأس من البحث لتطوير القابليات العلمية بحثت لك في احد المواقع الاجنبية ووجدت لك هذا الكود وغيرت فيه باسماء الحقول لتكون مناسبة مع برنامجك ارجو ان يفيدك في مطلبك ALTER TABLE dbo.B ADD CONSTRAINT FK_Branch FOREIGN KEY (Branch) REFERENCES dbo.A(BranchName); ALTER TABLE dbo.B ADD CONSTRAINT FK_Branch2 FOREIGN KEY (Branch2) REFERENCES dbo.A(BranchName);

السؤال مش واضح يعني من خلال النموذج الرئيسي تريد عمل تحديث للنموذج الفرعي ؟؟ ولا اعلم ما الحكمة انك لا تريد عمل requery بعد التحديث ؟؟ لا اعتقد انك تستطيع اغلاق وفتح نموذج فرعي لأنه جزء من النموذج الرئيسي اما اذا اردت اغلاق وفتح النموذج الرئيسي بعد التحديث اعمل close open

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

تفضل والكود الأول ينسخ مئة بالمئة ولكن يحتاج لتغيير البيانات حسب ما هو في الجدول الخاص بك جرب ووافني بالنتيجة Pro1N.rar

السلام عليكم -لو كنت تقصد اهتزاز الشاشة يمكنك ادخال هذا السطر في الكود لمنع اهتزاز الشاشة Application.ScreenUpdating = False وهذا السطر الأخر للرجوع للحالة الأولى للملف Application.ScreenUpdating = true على الرغم بعد ذلك عند رفع اى استفسار او مشاركة فلابد من رفع الملف لتوفير الوقت في المساعدة

وعليكم السلام بارك الله فيك استاذ عبد اللطيف وفى صاحب البرنامج الأستاذ صادق جعله الله فى ميزان حسناتكما

عمل رائع استاذ محمد بارك الله فيك ولإثراء الموضوع هذا حل اخر بدون اكواد ساقية.xls