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

تفضل إضافة و حذف مرفقات.rar

السلام عليكم عودة ميمونة أخي أبا جودي إليك كود إضافة المرفقات لجدول: On Error Resume Next DoCmd.Save Dim i As Integer Dim txtpath As String Dim rsPictures Dim db As DAO.Database Dim rsEmployees As DAO.Recordset 'Dim rsPictures As DAO.Field i = CurrentRecord - 1 With Application.FileDialog(1) .AllowMultiSelect = False .Title = "ÇÎÊÑ ãßÇä ÇáÍÝÙ" If .Show = -1 Then txtpath = .SelectedItems.Item(1) End If End With '------------------------------------------ Set db = CurrentDb Set rsEmployees = db.OpenRecordset("tbl") rsEmployees.Move (i) rsEmployees.Edit Set rsPictures = rsEmployees.Fields("attach1").Value rsPictures.AddNew rsPictures.Fields("FileData").LoadFromFile txtpath rsPictures.Update rsEmployees.Update Set rsEmployees = Nothing Set rsPictures = Nothing Me.Refresh و هذا كود الحذف: On Error Resume Next DoCmd.Save Dim i As Integer Dim txtpath As String Dim rsPictures Dim db As DAO.Database Dim rsEmployees As DAO.Recordset i = CurrentRecord - 1 '------------------------------------------ Set db = CurrentDb Set rsEmployees = db.OpenRecordset("tbl") rsEmployees.Move (i) rsEmployees.Edit Set rsPictures = rsEmployees.Fields("attach1").Value rsPictures.Delete rsEmployees.Update Set rsEmployees = Nothing Set rsPictures = Nothing Me.Refresh مع العلم أن tbl هو اسم الجدول و attach1 هو اسم الحقل و هذا مرفق للتوضيح. attach.rar

جرب المرفق 123.accdb Private Sub n_AfterUpdate() If IsNumeric([n]) Then m = 0 Else m = 20 End If End Sub

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

العفو أخي وفقك الله إلى ما يحبه و يرضاه إن شاء الله

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

جرب هذا التعديل attach.rar

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

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

@kha9009lid جزاك الله كل خير .. نعم هذا هو المطلوب شكرآ جزيلآ لك @ابا جودى وفقك الله و حقق ما في بالك شكرى جزيلآ لك تمت الإجابة و لله الحمد

طبعا استاذى الجليل واخى الجبيب والعزيز على قلبى الاستاذ @Barna جزاه الله خيـــر كفى ووفى وإثراء للموضوع اضف هذا المرفق - اختزال كامل وشامل لكود حساب العمر - الحساب مباشرة داخل النموذج بمجرد وضع التاريخين - عدم اضافة اى بيانات داخل الجدول نتيجة لاحتساب العمر فقط يحتسب العمر من الدالة داخل الموديول ومن خلال الاستعلام دفعة واحدة لاى عدد من السجلات مهما كان الفرق بين تاريخين.mdb

طبعا كل اساتذتى الكرام واخوانى الاحباب كفوا ووفوا جزاهم الله خيرا ومساهمة من العبد الفقيـر الى الله هذا المرفق للاستاذى الجليل ومعلمى القدير الاستاذ @أبو آدم جمال المرفق فى انه ان وجدت اكثر من طابعة يمكن فى كل مرة اختيار احداهم بكل يسر ومرونة NA_ReportPrenter.mdb

وتيسيرا على احبابى الاستاذ @محمد صلاح1 و الاستاذ @عبد اللطيف سلوم هذا مثال عملى getMacAddress.mdb

السلام عليكم ورحمة الله تعالى وبركاته الجزء الاول من صلاحيات دخول المستخدمين الى البرنامج فى هذا الجزء - فى حالة عدم وجود مستخدم مسجل اى عند فتح القاعدة للمرة الأولى يتم انشاء المستخدم الأدمن اليا يا سلام يا سلام -البيانات فى الجداول مشفرة << -----------< تلبية ورغبة لطلب احبائى الكرام -تم إخفاء معظم كائنات قاعدة البيانات التى تخص دخول المستخدمين -نموذج الدخول يمكن من خلاله تسجيل مستخدم جديد فى انتظار الادمن للموافقة عليه وتصنيفه تبعا لمجموهة الصلاحيات << -----------< الادمن كده هيستريح الله الله الله -نموذج الدخول يمكن من خلاله استرجاع كلمة المرور فى حالة النسيان ولكن بعد ادخال بيانات التسجيل الصحيحة ( اسم الدخول - الاسم الرباعى - الايميل- سؤال الامان - اجابة السؤال) -امكانية كشف نجوم كلمة المرور ما تيجو نشوف كده قد يكون هناك اخطاء سهوا منى وقد تكون هناك لدى احد اساتذتى الكرام واحبائى فكرة افضل يسعدنى تلقى مقترحاتكم حول المرفق القاعدة مطروحة للتجربة ـــــــــــــــــــــــــــــــــــــــــــــ SecurityLevel group.accdb SecurityLevel group.mdb

شكرا

تفضل الأمر سهل وبسيط يمكنك مشاهدة هذا الفيديو https://www.youtube.com/watch?v=JOGUVtuJAQ4

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

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

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

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

عمل رائع ومجهود ممتاز مشكور وجزاك الله خيراً

فكرة رقم ( 2 ) 123-up (2).accdb

ممكن من فضلك تذكر مثالا مفصلا اكثر لطلب حضرتك للتضح الرؤية اكثر ففهم السؤال كما تعلمت على ايدي اساتذتى العظماء هو نصف الاجابة

شكرا تم الانتهاء يغلق شكرا جزيلا استاذي مهند حسين

تم اضافة 3 مخازن كل منها يحتوى على تصنيفات 3 (5).accdb

تفضل لك ما طلبت ربط قائمة منسدلة بأخرى.xlsm

وعليكم السلام-تفضل ان لم يكن هذا هو المطلوب فعليك بتوضيح المطلوب اكثر ووضع شكل النتائج المطلوبة موزع.xlsx

x = Application.Match(Val(Application.Max(ws.Columns(1))), ws.Columns(1), 0) If Not IsError(x) Then tbID = ws.Cells(x + 1, 2).Value '============================================== x = Application.Match(Val(Application.Max(ws.Columns(1))), ws.Columns(1), 0) If Not IsError(x) Then tbID = ws.Cells(x + 1, 2).Value استاذة OmHamza قلت ان الرقم المدني يعمل تلقائي سابقا ولكن في الواقع لن يعمل كما هو موضح في الكود المخصص لهذه الوضيفة علما ان العمود في صفحة العمل هو (B) عموما انا تركته كما في مشاركتك الاولى وهو كما ترين في الاسطر اعلاه. اما بالنسبة لكمبوبوكس "الشارع" تم اضافته في الفورم انظري المرفق تحياتي قاعده ادخال البيانات.xlsm

قريبا إن شاء الله بسيطة

اخي الكريم للطباعة مباشرة DoCmd.OpenReport "اسم التقرير" و من طريقة عرض التصميم للتقرير اذهب الى اعدادات الصفحة و اتبع التالي لتحديد الطابعة

بعد ادن الاستادأحمد يوسف تفضل جرب المرفق مخزن الأثاث.xlsm

الماكرو يجب وضعه في كود الصفحة التي تحتوي على cmdSearch وليس في Module مستقل

بارك الله بك اخي مصطفى وهذا عمل اخر يقوم بنفس الشيء لكن بدالة معرفة UDF الكود بداية Option Explicit Function Salim_Split_Name(N_name, n) Dim x% Dim arr: arr = _ Array("سيف", "عبد", "أبو", "ابو", "عز", _ "صدر", "نور", "فضل") '++++++++++++++++++++++++++++++++++++++ Rem Array تستطيع ان تضيف اي بداية اسم مركب داخل هذا الــ '+++++++++++++++++++++++++++++++++++++ Dim My_Col As New Collection Dim Final_col As New Collection Dim it, my_st, my_name my_st = Trim(N_name) my_name = Split(Trim(my_st)) For x = LBound(my_name) To UBound(my_name) My_Col.Add my_name(x) Next x For x = 1 To My_Col.Count If Not (IsError(Application.Match(My_Col(x), arr, 0))) Then Final_col.Add My_Col(x) & " " & My_Col(x + 1) x = x + 1 Else Final_col.Add My_Col(x) End If Next x If n > Final_col.Count Then Salim_Split_Name = "" Else Salim_Split_Name = Final_col(n) End If Set My_Col = Nothing: Set Final_col = Nothing Erase arr End Function نموذج عن الدالة وكيفية عملها في الملف المرفق Fuction_split_name.xlsm

جزاك الله كل خير أستاذ سليم عمل رائع ولإثراء الموضوع بعد اذن حضرتك هذا حل اخر بالمعادلات العادية فإذا كان مثلا الرقم القومى موجود بالخلية A2 فيمكنك استخدام هذه المعادلة مع السحب بباقى الأعمدة =MID($A2,COLUMN(A2),1) الرقم القومي.xlsx

تفضل Test 2.rar

بارك الله فيك -تحت أمرك

أخى الكريم محمد انا قلت لك سابقا ربما هناك مشكلة معى مع ملفك فلا اعلم ما هو سبب عدم استطاعتى وضع اى كود فى ملفك لذلك ارسلت لك هذا الرابط من داخل المنتدى ربما يفيد طلبك كثيرا https://www.officena.net/ib/topic/59928-شاشة-دخول-مع-صلاحيات/

تفضل index3.xlsm

اخى الكريم شوف بنفسك بارك الله فيك

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

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

تفضل دالة تاريخ.xlsx

وعليكم السلام-لاحظ الصور هذه اسهل طريقة

وعليكم السلام تفضل ارشيف.rar

وعليكم السلام -اهلا بك فى المنتدى طالما انك لم تقم برفع ملف فهناك العديد من الطرق منها : يمكنك مشاهدة هذا الفيديو https://www.youtube.com/watch?v=nF1VNTGzN3c https://www.youtube.com/watch?v=qU1z3jdUZ_g وهذا ايضا رابط للتحويل مباشرة من الوورد الى الإكسيل https://convertio.co/ar/doc-xls/ وهذه طريقة سهلة لتحويل ملفات الورد لإكسيل دون الحاجه لبرامج تحويل الملفات 1- إفتح ملف الورد المراد تحويله لإكسيل word .doc 2- قم بحفظة على صورة ملف بصيغة اتش تي ام ال أو صفحة إنترنت باسم الملف المراد تحويلة file / save as / web page format 3 – قم بفتح ملف اكسيل جديد open new xls 4- اضغط على فتح في قائمة ملف open /brwos/ select file 5- إختار الملف بصيغة الاتش تي ام ال السابق تحويله file html. 6- قم بحفظ الملف ذاته بأختيار صيغة اكسيل ورقة عمل باختيار احد صيغ الأكسيل باصداراته المراد انشاؤها file/ save as/ xls 97/2033 وهذا رابط اخر من داخل المنتدى ناقش نفس الموضوع https://www.officena.net/ib/topic/33342-المطلوب-ملف-وورد-به-جداول-طولية-تحويله-الى-ملف-اكسل/ وهذه فيديوهات كمان لنقل البيانات من الوورد الى الإكسيل بأكواد VBA : https://www.youtube.com/watch?v=9QJXmsczaP8 https://www.youtube.com/watch?v=5IRWMSBmw1w وهذا كود تحويل ايضا Sub importTableDataWord() ‘We declare object variables for Word Application and document Dim WdApp As Object, wddoc As Object ‘Declare a string variable to access our Word document Dim strDocName As String ‘Error handling On Error Resume Next ‘Activate Word it is already open Set WdApp = GetObject(, “Word.Application”) If Err.Number = 429 Then Err.Clear ‘Create a Word application if Word is not already open Set WdApp = CreateObject(“Word.Application”) End If WdApp.Visible = True strDocName = “C:\our-inventory\inventory.docx” ‘Check relevant directory for relevant document ‘If not found then inform the user and close program If Dir(strDocName) = “” Then MsgBox “The file ” & strDocName & vbCrLf & _ “was not found in the folder path” & vbCrLf & _ “C:\our-inventory\.”, _ vbExclamation, _ “Sorry, that document name does not exist.” Exit Sub End If WdApp.Activate Set wddoc = WdApp.Documents(strDocName) If wddoc Is Nothing Then Set wddoc = WdApp.Documents.Open(strDocName) wddoc.Activate ‘define variables to access the tables in the word document Dim Tble As Integer Dim rowWd As Long Dim colWd As Integer Dim x As Long, y As Long x = 1 y = 1 With wddoc Tble = wddoc.tables.Count If Tble = 0 Then MsgBox “No Tables found in the Word document”, vbExclamation, “No Tables to Import” Exit Sub End If ‘start the looping process to access tables and their rows, columns For i = 1 To Tble With .tables(i) For rowWd = 1 To .Rows.Count For colWd = 1 To .Columns.Count Cells(x, y) = WorksheetFunction.Clean(.cell(rowWd, colWd).Range.Text) ‘Access next column y = y + 1 Next colWd ‘go to next row and start from column 1 y = 1 x = x + 1 Next rowWd End With Next End With ‘we don’t need to save the word document wddoc.Close Savechanges:=False ‘we quit Word WdApp.Quit ‘We finally release system memory allocated to the 2 object variables Set wddoc = Nothing Set WdApp = Nothing End Sub

تفضل المصنف100.xlsm

يجب عليك ضبط لغة جهازك وذلك من خلال الشرح الموجود على هذا الرابط https://www.officena.net/ib/topic/87988-اللغه-العربيه-في-الاكسيل-2010-لا-تظهر-بشكل-صحيح/?tab=comments#comment-556696

اخى الكريم يمكن تكون المشكلة لديك انت فكما ترى بالصورة هذا من الملف المرسل اليك .

أخى الكريم تم التعديل لاحظ بنفسك هذا هو الكود الجديد Sub DatedIf_User() Dim ws As Worksheet, Sh As Worksheet, Mh As Worksheet Dim ShName As String, Rng As Range, C As Range Dim LR As Long, VlDate As Variant Application.ScreenUpdating = False Set ws = Sheets(ActiveSheet.Name) VlDate = ws.Range("E2").Value '---------------------------------- LR = ws.Cells(Rows.Count, "C").End(xlUp).Row ws.Range("F10:H" & LR + 1).ClearContents Set Rng = ws.Range("E10:E" & LR) '---------------------------------- If IsEmpty(VlDate) = True Then MsgBox "من فضلك ادخل تاريخ حساب السن" Exit Sub Else On Error Resume Next For Each C In Rng If C.Value <> "" Then YY = Year(VlDate) y = Year(C.Value) mm = Month(VlDate) m = Month(C.Value) dd = Day(VlDate) D = Day(C.Value) '----------------------- If D > dd And m > mm Then C.Offset(0, 1) = dd + 30 - D C.Offset(0, 2) = mm - m + 11 C.Offset(0, 3) = YY - y - 1 '----------------------- ElseIf D <= dd And m > mm Then C.Offset(0, 1) = dd - D C.Offset(0, 2) = mm - m + 12 C.Offset(0, 3) = YY - y - 1 '----------------------- ElseIf D >= dd And m = mm Then C.Offset(0, 1) = dd - D + 30 C.Offset(0, 2) = mm - m + 11 C.Offset(0, 3) = YY - y - 1 '----------------------- ElseIf D >= dd And m < mm Then C.Offset(0, 1) = dd - D + 30 C.Offset(0, 2) = mm - m - 1 C.Offset(0, 3) = YY - y '----------------------- Else C.Offset(0, 1) = dd - D C.Offset(0, 2) = mm - m C.Offset(0, 3) = YY - y End If End If Next End If Application.ScreenUpdating = True End Sub

بارك الله فيك استاذ ابراهيم وجزاك الله كل خير مجهود ممتاز جعله الله فى ميزان حسناتك ورحم الله والديك وغفر لهم واسكنهم فسيح جناته ,الفردوس الأعلى