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

تفضل إضافة و حذف مرفقات.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

لا شكر على واجب استاذي الكريم @صالح حمادي

شكرا

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

شكرا أخي ابا جودي نستطيع استعمال الكود بهذا الشكل من أجل ظهور جميع صيغ الصور في وقت واحد. .Filters.Add "IMAGE Files", "*.png, *.bmp, *.jpg, *.wmf"

قم بادراج ورقة وتسميهتا Salim (أو قم بتسمية اي ورقة فارغة Salim) ثم نفذ هذا الكود (و ترى النتيجة في شيت Salim) Option Explicit Sub REMOVE_DUPL() Sheets("Salim").Range("a1").CurrentRegion.Clear Sheets("Feuil1").Range("a1").CurrentRegion.Copy _ Sheets("Salim").Range("a1") Sheets("Salim").Range("a3").CurrentRegion.RemoveDuplicates _ Columns:=Array(2, 6, 7, 8, 9, 10 _ , 11, 12, 13, 14, 15), Header:=1 Application.CutCopyMode = False End Sub الملف مرفق Classeur32_A.xlsm

وذلك تعديل جديد لعرض الشعار فى كل زوايا القاعدة imgLogo.Picture = MyLogo() على ان يتم استبدل كلمة imgLogo باسم عنصر التحكم الخاص بالصورة كما تسميه انت Logo Company (Up 3).mdb

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

أحبك الله الذي أحببتني له

واثراء للموضوع طالما سبقنى استاذى الجليل الاستاذ @صالح حمادي هذه فكرة على طريقة استاذى الجليل ومعلمى القدير الاستاذ @jjafferr حمل الصورة داخل القاعدة وليس مرفق والقاعدة المرفقة بتنسيق 2003 افتح القاعدة فى مجلد فارغ ولاحظ وجود الشعار فى النموذج اذهب للمجلد الذى وضعت به القاعدة تجد مجلدات تم اضافتها وبداخلها الشعار امسح الشعار وقم باغلاق وفتح القاعدة وشاهد السحر قم بتغيير الشعار مهما كان اسمه ومهما كانت صيغة الملف jpg . png bmp ارجع الى المجلدات تجد الشعار الجديد وحذف القديم واستبداله داخل القاعدة مهما كان اسم الشعار دون ادنى تدخل من المستخدم Logo Company.mdb اعتذر للتأخير كان وقت الصلاة

السلام عليكم جرب المرفق اضغط فوق الزر الأحمر بالزر اليمين للفأرة سوف تظهر لك قائمة بها ثلاثة عناصر كل عنصر له أمر معين تستطيع التعديل على الأوامر و المسميات من الوحدة النمطية و وحدات الماكرو الكود.rar

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

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

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

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

هذا الكود يفي بالغرض ان شاء الله (تم تغيير اسماء الصفحات لنسخ الكود بشكل جيد وعدم الوقوع في مشاكل اللغة حيث تظهر حروف غير معروفة عند البعض) Option Explicit Sub AnyThing() Dim lastrow_1 As Long, counter As Long Dim lastrow_2 As Long, key As Variant Dim sh1 As Worksheet, sh2 As Worksheet Dim rng1, rng2 As Range, p As Variant Dim dict As Object Set sh1 = Sheets("SH1") Set sh2 = Sheets("SH2") sh2.Range("I3").Resize(1000, 3).ClearContents lastrow_1 = sh1.Cells(sh1.Rows.Count, "B").End(3).Row lastrow_2 = sh1.Cells(sh2.Rows.Count, "B").End(3).Row Set rng1 = sh1.Range("A3:D" & lastrow_1) Set rng2 = sh2.Range("A3:D" & lastrow_2) Set dict = CreateObject("Scripting.Dictionary") For Each p In rng1.Columns(2).Cells If Not dict.Exists(p.Value & "," & p.Offset(, 1)) Then dict.Add p.Value & "," & p.Offset(, 1), p.Offset(, 2) Else dict(p.Value & "," & p.Offset(, 1)) = _ dict(p.Value & "," & p.Offset(, 1)) + p.Offset(, 2) End If Next p '=============================== For Each p In rng2.Columns(2).Cells If Not dict.Exists(p.Value & "," & p.Offset(, 1)) Then dict.Add p.Value & "," & p.Offset(, 1), p.Offset(, 2) Else dict(p.Value & "," & p.Offset(, 1)) = _ dict(p.Value & "," & p.Offset(, 1)) + p.Offset(, 2) End If Next p '============================== counter = 2 With sh2 For Each key In dict.Keys counter = counter + 1 .Cells(counter, "I").Resize(1, 2) = Split(key, ",") .Cells(counter, "K") = dict(key) Next key End With dict.RemoveAll: Set dict = Nothing Set sh1 = Nothing: Set sh2 = Nothing Set rng1 = Nothing: Set rng2 = Nothing End Sub الملف المرفق Total.xlsm

تفضل Test 2.rar

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

تفضل اخى الكريم محمد لك ما طلبت فقد تم العمل كما ترى بالصورة test.rar

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

تفضل index3.xlsm

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

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

تفضل ولكن ظهور مثل هذه الرسائل وذلك لإحتواء الملفات على فيروس فهذا منطقى لظهور هذه الرسالة فالطبيعى ان تفتح الملفات مباشرة بمجرد الضغط على الهايبر بارك الله فيك index2.xlsm

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

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

وعليكم السلام تفضل-يمكنك تجربة هذه الأكواد طالما انك لم ترفع ملف Private Sub UserForm_Initialize() TextBox1.Text = "" End Sub Private Sub CommandButton1_Click() TextBox1.Text = "Sid" MsgBox "Re-Initialzing the Userform" UserForm_Initialize End Sub Private Sub UserForm_Initialize() ChartNum = 1 UpdateChart_OverallOEE UpdateChart_OverallUnits UpdateChart_OverallWeights End Sub Private Sub UpdateChart_OverallOEE() Set CurrentChart = Sheets("Chart_OverallOEE").ChartObjects(ChartNum).Chart CurrentChart.Parent.Width = 710 CurrentChart.Parent.Height = 150 ' Save chart as GIF Fname = ThisWorkbook.Path & Application.PathSeparator & "Chart_OverallOEE.gif" CurrentChart.Export Filename:=Fname, FilterName:="GIF" ' Show the chart img_Chart_OverallOEE.Picture = LoadPicture(Fname) End Sub Private Sub UpdateChart_OverallUnits() Set CurrentChart = Sheets("Chart_OverallUnits").ChartObjects(ChartNum).Chart CurrentChart.Parent.Width = 700 CurrentChart.Parent.Height = 150 ' Save chart as GIF Fname = ThisWorkbook.Path & Application.PathSeparator & "Chart_OverallUnits.gif" CurrentChart.Export Filename:=Fname, FilterName:="GIF" ' Show the chart img_Chart_OverallUnits.Picture = LoadPicture(Fname) End Sub Private Sub UpdateChart_OverallWeights() Set CurrentChart = Sheets("Chart_OverallWeights").ChartObjects(ChartNum).Chart CurrentChart.Parent.Width = 700 CurrentChart.Parent.Height = 175 ' Save chart as GIF Fname = ThisWorkbook.Path & Application.PathSeparator & "Chart_OverallWeights.gif" CurrentChart.Export Filename:=Fname, FilterName:="GIF" ' Show the chart img_Chart_OverallWeights.Picture = LoadPicture(Fname) End Sub

تفضل index2.xlsm

وعليكم السلام كان عليك من البداية استخدام خاصية البحث فى المنتدى تفضل https://www.officena.net/ib/topic/87818-استفسار-عن-طريقة-اضافة-اكثر-من-مستخدم/?tab=comments#comment-555050

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

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

عليك برفع ملف وشرح المطلوب عليه بالتفصيل

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

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

اخى الكريم لماذا لم ترى الملف ؟ كيف تقول ان هناك اختلاف وهو نفس الملف الذى ارسلته ارسل صورة الإختلاف لو سمحت طالما انك ترى ان هناك اختلاف

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

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

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