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

تفضل ... تسجيل التغيرات.rar

السلام عليكم استشارني صديق بشأن معادلة لبيان حالة سجل المتابعة لتبيان اذا ما كان تم انجازه قبل أو في أو بعد الوقت أو ما زال قيد الانجاز كما هو موضح فى الشكل و الملف المرفق، فاعددت له المثال المرفق عن طريق المعادلات و بصرف النظر عن الحلول الأخرى الممكنة باستخدام الاكواد ، اتصور انه ربما توجد حلول افضل بالمعادلات أيضا ، لذا طرحته للفائدة و الاستفادة والاستزادة من مقترحات الأخوة الكرام =IF(D3=E3,"بحسب المخطط",IF(E3>D3,"متأخر",IF(E3="",IF(D3<TODAY(),"فات الوقت","قيد الإنجاز"),"متقدم"))) =IF(D13=E13,"On Time",IF(E13>D13,"Delayed",IF(E13="",IF(D13<TODAY(),"Overdue","In Process"),"Ahead"))) مرفق الملف LogTracking.xlsx

Try this File Jack_Numeration.xlsm

السلام عليكم ورحمة الله وبركاته أستاذي العزيز جرب الملف الآتي عملت فيه كودين واحد لإضافة درجة القرار والأخر لحذفها في حالة قررت التراجع عن قرار الإضافة إن شاء الله يلبي طلبك اضافة درجة القرار للطلاب1.xlsm

تفضل هذه المعادلة لعد أحرف الخلية =LEN(A4) أما بالنسبة لتحديد كتابة 31 حرف أو أقل فقط بالخلية فهذا يتم من خلال DataValidation كما بالصورة وتم تنفيذ ذلك على الملف بالفعل دالة عدد الاحرف.xlsx

بارك الله فيك استاذ محي الدين وهذا ماكرو اخر لنفس الهدف (زيادة في اثراء الموضوع) Option Explicit Sub Expand_Me() Dim i%, M%, y%, x As Byte M = 2 y = Sheets("Feuil1").Range("A1"). _ CurrentRegion.Rows.Count If y = 1 Then Exit Sub With Sheets("Feuil2") .Range("A1").CurrentRegion.ClearContents .Range("A1").Resize(, 14).Value = _ Sheets("Feuil1").Range("A1").Resize(, 14).Value For i = 2 To y x = Sheets("Feuil1").Range("G" & i) .Range("A" & M).Resize(x, 14).Value = _ Sheets("Feuil1").Range("A" & i).Resize(, 14).Value M = x + M Next i End With End Sub

اذا اردت حذف يومين تحتارهما اليك هذا الملف (صفحة Salim) date_without 2 days.xlsx

Essayez ce fichier Naser_date.xlsx

يسرني ويسعدني أن أضع بين يديكم برنامج التدريب الالكتروني قمت بتصميمه من الصفر أخذ مني جهد ووقت كبير . استفدت من خبراء هذا المنتدى المبارك. لي طلب أن تدعو لوالدي وجميع مرضى المسلمين والمسلمات بالشفاء العاجل. هذا المشروع أضعه صدقة جارية لكل طالب علم ، و كل مشارك في هذا المنتدى . أسأل الله أن يتقبل منا ومنكم صالح الأعمال . ولا تنسونا من دعواتكم الصادقة في ظهر الغيب . اترك البرنامج لكم لتكتشفوا أسراره 😄 اضف مرفقات موجوده ProTraining20.zip

السلام عليكم 🙂 رجاء مراجعة موضوع النسخة 2 من هنا : واجهة هذه النسخة: البرنامج يقوم بهذه الخطوات التي يوصي بها المحترفين (كما هو موضح في الصورة اعلاه) ، طريقة العمل: 1. اختار ملف اكسس ، 2. اذا الملف محمي بكلمة سر ، فيمكن كتابته في المربع المخصص ، حيث سيتم حفظه في ذاكرة الكمبيوتر ، والتي يجب عليك ان تدخلها يدويا للقيام بالخطوات 2 و 3 لمرة واحدة ، بينما البرنامج سيدخلها تلقائيا للخطوات التالية ، 3. يجب ان تمسك مفتاح الشفت ، ثم تضغط على زر Decompile ، ولا تترك الزر إلا لما ينتهي البرنامج من عمله ، عندما نرى الخطوات 8 و 9 🙂 هذه النسخة اسرع من النسخة السابقة ، وافضل 🙂 جعفر Decompile_3.zip

جب هذا الملف jack_Gardes.xlsx

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

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

تم التعديل الشيت Salim من هذا الملف Jack_Numeration_1.xlsm

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

أسأل الله أن ييسر لكم هذا الوقت بالقريب العاجل فنحن نتوق لذلك وننتظره وجزاكم الله عنا خيرا. 123

وعليكم السلام ورحمة الله وبركاته أعتقد أن الأمر سهل كل ما تحتاجه هو تكرار الكود وتعديل ما يلزم من أسماء عناصر التحكم مثل هذا Dim Psh As String, psh2 As String On Error GoTo Err Psh = CurrentProject.Path & "/" & "الصور" & "/" & [ID] & ".jpg" Psh2 = CurrentProject.Path & "/" & "1الصور" & "/" & [ID] & ".jpg" pic.Picture = Psh pic1.Picture = Psh2 Exit Sub Err: pic.Picture = "" pic1.Picture = "" Exit Sub جرب هذا ووافنا بالنتائج - وان كنت قد فهمت مرادك بشكل خاطئ فأرجو مزيد من الايضاح. تمنياتي بالتوفيق

هلا جعلت اجابت أخيك أفضل اجابة - ان كانت اجابته وفت مرادك - وليبدو موضوعك أنه مجاب

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

اھلا بک فی منتداک اذا تقدر ان ترفع نسخة مصغرة من قاعدة بياناتك سيسهل على رفقائك في المنتدى لكي يساعدك حسب فهمي لسؤالك اكتب كود الطباعة ثمانية مرات كل مرة باسم تقرير خاص تبعك لكن لا تنسى ان تعطيه شرط ريكورد لكي لا تطبع كل صفحات هذا كود طباعة DoCmd.OpenReport "Rep1", acViewNormal, , "[id]=" & Me.ID DoCmd.OpenReport "Rep2", acViewNormal, , "[id]=" & Me.ID DoCmd.OpenReport "Rep3", acViewNormal, , "[id]=" & Me.ID DoCmd.OpenReport "Rep4", acViewNormal, , "[id]=" & Me.ID DoCmd.OpenReport "Rep5", acViewNormal, , "[id]=" & Me.ID DoCmd.OpenReport "Rep6", acViewNormal, , "[id]=" & Me.ID DoCmd.OpenReport "Rep7", acViewNormal, , "[id]=" & Me.ID DoCmd.OpenReport "Rep8", acViewNormal, , "[id]=" & Me.ID

ماشاء الله استاذعلي رائــــــــــع جدااا

أرجو منك تحديد أفضل إجابة على مشاركتك؛ وذلك بالضغط على كلمة "اختر كأفضل إجابة" تحت المشاركة الأفضل بالنسبة لك..

وهكذا؟ TESTE55 With code (2).xlsm

تفضل - تم التعديل البرنامج الجديد 2021.xlsm

تفضل اخى الكريم -يمكنك استخدام هذا الكود ... تم التعــديــل من فضلك عليك بأستخدام خاصية البحث بالمنتدى قبل رفع مشاركتك حتى لا يتم اهدار مزيد من الوقت فى موضوعات قد تكررت وتم تناولها عشرات المرات Sub Test() Dim rng1 As Range Dim str_search As String ThisWorkbook.Sheets("البداية").Activate str_search = Range("b6").Value ThisWorkbook.Sheets("التقرير").Activate Set rng1 = Sheets("التقرير").Range("a:a").Find(str_search, , xlValues, xlWhole) If rng1 Is Nothing Then Dim lastRow As Long lastRow = ThisWorkbook.Sheets("التقرير").Range("A1000000").End(xlUp).Row lastRow = lastRow + 1 With ThisWorkbook.Sheets("التقرير") .Range("A" & lastRow).Value = Sheets("البداية").Range("B6").Value .Range("B" & lastRow).Value = Sheets("البداية").Range("B7").Value .Range("C" & lastRow).Value = Sheets("البداية").Range("B8").Value End With Sheets("البداية").Range("B6").Value = "" Sheets("البداية").Range("B7").Value = "" Sheets("البداية").Range("B8").Value = "" Else MsgBox str_search & " موجود مسبقا" ThisWorkbook.Sheets("البداية").Activate End If End Sub test 3.xlsm

وعليكم السلام-تم عمل المطلوب وزيادة ... فقد تم تنسيق شكل الفاتورة وعمل قواءم منسدلة لأسماء الأصناف وأسماء العملاء حتى يتم الأختيار من بينهم وان لا يوجد مجال للخطأ عند الكتابة -بارك الله فيك وأتمنى ان ينال إعجابك فاتورة_3.xlsm

من بعد أذنك استاذ سليم طريقة أخرى TESTE55 With code.xlsm

Private Sub cmdSearch_Click() Dim strSearch As String Dim rs As Object Set rs = Me.RecordsetClone If IsNull(Me![txtSearch]) Or (Me![txtSearch]) = "" Then MsgBox "رجاء ادخل اسم للبحث عنه", vbOKOnly, "خطأ في البحث" Me![txtSearch].SetFocus Exit Sub End If strSearch = Me![txtSearch] With rs ' .FindNext "[EmpName] = '" & strSearch & "'" .FindNext "[EmpName] like '*" & strSearch & "*'" If Not .EmpName Like "*" & strSearch & "*" Then ' If .EmpName <> strSearch Then MsgBox "لا يوجد سجل بهذا الإسم : " & strSearch, , "غير موجود" Me.txtSearch = "" Me![txtSearch].SetFocus ElseIf .NoMatch Then MsgBox "آخر سجل في البحث عن : " & strSearch, , "آخر سجل" Me.cmdSearch.Caption = "بحث" Me.txtSearch = "" Me![txtSearch].SetFocus Me.cmdSearch.ForeColor = RGB(0, 0, 255) DoCmd.GoToRecord , , acFirst Else Me.Bookmark = .Bookmark MsgBox "تم ايجاد اسم : " & strSearch, , "مبروك" Me.cmdSearch.Caption = "اكمال البحث" Me.cmdSearch.ForeColor = RGB(255, 0, 0) End If End With rs.Close Set rs = Nothing End Sub تفضل اخي الكريم هذا التعديل على نفس الكود. واليك الملف بعد التعديل وافينا بالنتيجة تحياتي za-EmployyeUP.accdb

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

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

مشاركة مع استاذ علاء MyDataBase100.rar

بالنسبةلامكانية ظهور الرقم عن طريق الاسم فلا استطيع ان افيدك لكن عندي طريقة اظن انك ما تحتاج غيرها والله اعلم وهي انه عند اختيار الرقم من القائمة تظهر لك الأسماء إلى جانب الأرقام في نفس القائمة شوف المرفق MyDataBase.accdb

وهذه مشاركة مع أخي الاستاذ . حسام Kanory.rar

السلام عليكم تفضل هذه المحاولة ارجو ان تكون طلبك Root111.rar

السلام عليكم ورحمه الله وبركاته اخي حسين مامون سالتني ما المقصود بانشاء شيت2 وترحيل نفس البيانات في شيت1 اماشيت واحد للفواتير لي مازال عليها دين وشيت2 كارشيف لجميع الفواتير اما اذا قمت بي انشاء شيت الاستعلام عن فواتيري لي علىها دين وشيت اخر كارشيف تكون عمليه الاستعلام عن الفواتير بسرعه لان الفواتير علىها دين في شيت 1 قد تصل إلى عشره او 15 و 20 اما ورقه الارشيف قد تصل الى 1000 او 2000 اما الفاتوره اذا تما تسديد دينها يتم ازالتها من شيت واحد وتبقى كارشيف في شيت اثنان جزاكم الله عنا خير الجزاء، وأبعد عن قلوبكم الحزن والشقاء ،وجعلكم من السابقين فى الخيرات، وأدخل إلى قلوبكم سرور الطاعات ،وختم عملكم بالباقيات الصالحات

بارك الله فيك استاذ محي ... ولإثراء الحل -يمكنك استخدام هذه المعادلة , مصفوفة (Ctrl+Shift+Enter) =SUMPRODUCT(0+(0&TRIM(MID(SUBSTITUTE(B2,"+",REPT(" ",10)),ROW($A$1:$A$10)*10-9,10)))) معادلة جمع1.xlsm

يمكنك هذا بهذه المعادلة =IF(ROWS($A$1:A1)>DAY(EOMONTH(DATE($D$2,$F$2,1),0)),"",DATE($D$2,$F$2,ROWS($A$1:A1))) 81.xlsx