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

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

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

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

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

نورت الدنيا كلها استاذنا وحبيبنا @ابا جودى

وفقك الله استاذي المحترم @ابا جودى عذبتك معي و الله .. ولكنني اظن اني انا من اسأت التعبير و المقصود !! في حال أن المربع n يحتوي على قيمة متضمنة لنص و ارقام معآ مثلا [79wwdddd652 ] فان قيمة m هي 20 أما في حال أن المربع n يحتوي على قيمة متضمنة لارقام فقط مثلا [123456789] فان قيمة m هي 0 حقك علي و الله

اتمنى اكون قدرت افهمك كويس اتفضل جرب 123-up.accdb

وهذا المرفق ايضا اثراء للموضوع وللامانه لا اذكر من اين حصلته لكن قمت ببعض التعديلات التى تتماشى مع افكارى ومتطلباتى ولكنه يتيح تحكم اشمل واعم من المرفق السابق Full Control Of Print Report.accdb

تفضل اخي العزيز المبيعات.rar

تم التعديل على الملف المرفق سابقا للمرة الثانية

جربي المرفق قاعده ادخال البيانات (3).xlsm

نعمل صفحة ونسيمها قائمة ومنها عند تغير الصفحة تفتح صفحة جديدة بدل الفورم ثم نفتح قائمة منسدلة فى الصفحة الرئيسية الى عليها الشغل لما يحصل تغير فى الصفحة يدور على اسم الصفحة مع الاسم فى العموود ويرحل البيانات مدة مش محتاجين اى فورم وبهذا وفرت وقت ومجهود واتمنى ان الفكرة تعجب الاساتذة

تفضل هذا التعديل الحاق من النموذج الي الجدول.accdb

نور الموقع بعودتك @ابا جودى الحمد لله على السلامة

أخي @المهاجر ابو معاذ قم بنسخ المحدد كما بالصور .. الى ملفك الذي تريد وضع هذه الاكواد كالتالي: تحت زر ضع كود فتح التقرير DoCmd.OpenReport "rpt_rensen", acViewPreview salah_hommadi و في التقرير حدث عند التحميل DoCmd.Maximize change_font (Me.Name)

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

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

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

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

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

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

تفضل ولكن ظهور مثل هذه الرسائل وذلك لإحتواء الملفات على فيروس فهذا منطقى لظهور هذه الرسالة فالطبيعى ان تفتح الملفات مباشرة بمجرد الضغط على الهايبر بارك الله فيك 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

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

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

احسنت استاذ سليم كود ممتاز جعله الله فى ميزان حسناتك

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

تفضل دفتر اليوميه كمال.xlsx

وعليكم السلام تفضل المطلوب.xlsx

هذا هو الملف -كان عليك اخى الكريم رفع الملف لكى تتم الإستفادة للجميع ان شاء الله الشهيدة نهال العقيد.xlsm

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

. ثانية.rar

قد تم التعديل من قبل استاذنا الكبير ابراهيم الحداد فى المشاركة الأخرى له منا جميعا كل المحبة والإحترام 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("بيانات الطالبات") VlDate = ws.Range("I5").Value '---------------------------------- LR = ws.Cells(Rows.Count, "E").End(xlUp).Row If LR < 8 Then Exit Sub ws.Range("I8:K" & LR + 1).ClearContents Set Rng = ws.Range("H8:H" & 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