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

اتفضل تم اضافة هذا السطر من الكود If Me.Y = Me.C Then Me.TimerInterval = 0: MsgBox "تم ايقاف التشغيل العداد" 19 (1) (1).accdb

دالة رأيتها في مواضيع الأستاذ جعفر وأعجبتني كثيرا ، وحسب تعليقه في الموضوع أنها من ضمن ملف العون في محرر الـ VBA ولكني لم أستطع العثور عليها. على كل تطوير الدالة في النقاط التالية: 1 - تسهيل إدخال التاريخين دون التفكير أيهما الأصغر أو أيهما الأكبر. 2 - إتاحة زيادة يوم على العمر أو المدة عند الرغبة (اختياري). 3 - إعطاء الناتج على شكل سنة وشهر ويوم منفصلين بقيم رقمية بالإضافة إلى ناتج الدالة النصي. Public Function YMD_Diff(inDate1 As Date, inDate2 As Date, _ Optional outY, Optional outM, Optional outD, _ Optional AddOneDay As Boolean = False) As String 'تطوير لدالة YMDDif Dim inDate3 As Date Dim iYear As Integer Dim iMonth As Integer Dim iDay As Integer Dim dInterim1 As Date If inDate2 < inDate1 Then inDate3 = inDate1 inDate1 = inDate2 inDate2 = inDate3 End If 'AddOneDay عند الرغبة في إضافة يوم في العمر أو المدة inDate1 = inDate1 - Abs(AddOneDay) iMonth = DateDiff("m", inDate1, inDate2) If Day(inDate1) > Day(inDate2) Then iMonth = iMonth - 1 End If dInterim1 = DateAdd("m", iMonth, inDate1) outD = DateDiff("d", dInterim1, inDate2) outM = iMonth Mod 12 outY = iMonth \ 12 YMD_Diff = outY & "y/" & outM & "m/" & outD & "d" End Function 'إجراء لاختبار الدالة Sub Test2() Dim Date1 As Date Dim Date2 As Date Dim Y As Integer, M As Byte, D As Byte Date1 = DateSerial(1970, 3, 1) Date2 = Date Debug.Print YMD_Diff(Date1, Date2) Debug.Print "--------------------" Debug.Print YMD_Diff(Date1, Date2, Y, M, D) Debug.Print Y, M, D Debug.Print "--------------------" Debug.Print YMD_Diff(Date1, Date2, Y, M, D, True) Debug.Print Y, M, D Debug.Print "--------------------" End Sub

جزاك الله خيرا اخى واستاذنا @Shivan Rekany منور اخى محمد اضحكتنى وربنا يستر من الزلازل كفايه كورونا عفانا الله واياكم وجميع المسلمين فى شتى بقاع الارض وجعلها الله هدايه ورجوع اليه واجلال لقدرته وعظمته سبحانه وتعالى باالتوفيق اخى محمد

اهلا بك استاذنا / @Shivan Rekany جزاكم الله خير على التوضيح الاكثر من ممتاز لقد ارحت قلبى لانى تعبت من كثرة المحاولات على العموم فعلا حسب نصيحتكم عند تطبيق الاكواد النموذج كله يرتعش ويهتز كأن به زلازال 7.5 رختر وفضلت ان استخدم اى وسيله اخرى بارك الله فيكم وجعله فى ميزان حسناتكم واحسن الله الى اولادكم كل الاحترام والتقدير لكم

لا تنسى هذه الجزئية خانات الاختيار لا يمكنك ان تعمل عليه تعديل اي تضغط عليه في حالة خاصية عدم التعديل على الفورم لكن تقدر ان تستخدم زر بدل خانة الاختيار وسيفعل بشكل جيد لكن اذا تريد ان يكون خانة الاختيار وفي خاصية منع التعديل على النموذج هناك طريقة لكن غير مستحسنة واليك الكود Private Sub Option0_Click() DoCmd.OpenForm "f2", acNormal Me.Form.AllowEdits = False End Sub Private Sub Option0_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Me.Form.AllowEdits = True End Sub عند تحريك المؤشر الماوس على خانة الاختيار سيتغير خاصية منع التعديل الى نعم وبعدين عند الضغط سيفتح النموذج و يغير خاصية من جديد الى لا اليك الملف علامة اختيار.accdb

بعد اذن استاذ سليم تم تعديل رؤوس الاعمدة التي تمثل عناوين الجدول ليتم اضافتها في كل ورقة جديدة عمل الكود: 1- هل تريد تحويل الصفوف الى اوراق جديدة ؟ اختر نعم 2- ادخل عدد الصفوف 3- هل تريد تضمين صف العناوين ؟ احتر نعم ملاحظه - في الملف المرفق 1080 صف ويمثل عدد الاسماء .. سيتم انشاء 108 شيت !! - دمج الخلايا سيؤدي الى اخطاء في الكود تقسيم 2.xlsm

اعمل بحث في الموقع لأن في الموقع العديد من الأمثلة لما تريد وهذا الكود المستخدم في مثالك أحد أكواد أعضاء المنتدى ........ ESTest.mdb

السلام عليكم ورحمة الله وبركاته في أحد المشاريع التي قمت بها ، كنت محتاج الى برنامج خارجي ليقوم ببعض المهام للمشروع ، فالطريقة المعتادة التي نستعملها هي ، وضع البرنامج هذا داخل احد مجلدات المجلد الرئيسي لقاعدة البيانات ، وبما ان فقدان/حذف هذا البرنامج يجعل المشروع عاجز عن العمل ، لم يكن عندي خيار ، سوى ان اجعل هذا البرنامج داخل قاعدة البيانات ، بطريقة تسمى Blob المرفق فيه هذه الملفات: . النموذج frm_Blob مهم في انه يسمح لك بوضع برامجك في قاعدة البيانات بسهولة ، والزر الاخر هو لتصدير هذا البرنامج الى اي مجلد في الكمبيوتر (لعمل التجارب مثلا) ، وقد وضعت برنامجين في قاعدة البيانات المرفقة: 1. pdftk.exe والذي يقوم بالعديد من العمليات لملفات الـ pdf ، 2. Arc5_S_BE.mdb ، وهي قاعدة بيانات فاضية ، وبها جداول مؤقته ، فبدل ان اعمل هذه الجداول المؤقته داخل قاعدة بياناتي ، ويكبر حجمها ، رأيت ان استعمل جداول خارجية ، وعند اغلاق البرنامج ، كنت اقوم بحذفها من المجلد: . لعمل البرنامج الاول ، استخدم الزر رقم 1 ، والذي سيصدر البرنامج pdftk.exe الى مجلد قاعدة البيانات ، ثم سيدمج الملفين a.pdf و b.pdf ويحفظ النتيجة في ملف ab.pdf ، ويفتحه ، بينما الزر رقم 2 ، سيصدر قاعدة البيانات Arc5_S_BE.mdb الى المجلد الرئيسي لقاعدة بياناتنا: . عند الضغط على الزر 1 ، سنرى هذه الملفات في المجلد الرئيسي لقاعدة البيانات: . ان شاء الله يكون فيه فائدة للجميع جعفر Blob.zip

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

السلام عليكم استخدم الكود التالي: مع تغيير المسار الذي تريده من D:\ الي اي مجلد تريده المصدر : من هنـــا و مرفق الملف للتجربة ، هذا الملف يقوم بعد صفحات ملفات الpdf الموجودة فى المسار D:\ و تسجيلها فى ورقة العمل الاولى جرب و اخبرنا Sub Test() Dim MyPath As String, MyFile As String Dim i As Long MyPath = "d:\" MyFile = Dir(MyPath & Application.PathSeparator & "*.pdf", vbDirectory) Range("A:B").ClearContents Range("A1") = "File Name": Range("B1") = "Pages" Range("A1:B1").Font.Bold = True i = 1 Do While MyFile <> "" i = i + 1 Cells(i, 1) = MyFile Cells(i, 2) = GetPageNum(MyPath & Application.PathSeparator & MyFile) MyFile = Dir Loop Columns("A:B").AutoFit MsgBox "Total of " & i - 1 & " PDF files have been found" & vbCrLf _ & " File names and corresponding count of pages have been written on " _ & ActiveSheet.Name, vbInformation, "Report..." End Sub ' Function GetPageNum(PDF_File As String) 'Haluk 19/10/2008 Dim FileNum As Long Dim strRetVal As String Dim RegExp Set RegExp = CreateObject("VBscript.RegExp") RegExp.Global = True RegExp.Pattern = "/Type\s*/Page[^s]" FileNum = FreeFile Open PDF_File For Binary As #FileNum strRetVal = Space(LOF(FileNum)) Get #FileNum, , strRetVal Close #FileNum GetPageNum = RegExp.Execute(strRetVal).Count End Function GETPDF_pageno.xlsm

لا بأس أخي. تفضل رقم البطاقة على حسب المادة2.xlsx

جرب هذا الكود (تم تغيير اسم الصفحة الرئيسية الى Salim) من اجل حسن نقل الكود ولصقه بعض الأعمدة مخفية من الصفحة لنتمكن من رؤية كامل الجدول (يمكنك اظهارها بسهولة) Option Explicit Sub salim_code() Rem Created By Salim Hasbaya On 15/4/2020 Rem you can change then Number 10 by _ any number in all The code by changing ""tt"" Const tt = 10 Dim S As Worksheet, sh As Worksheet Dim Ro%, i%, n%, m%, t%, x%, max_ro% Dim arr() Set S = Sheets("Salim") Ro = S.Cells(Rows.Count, 1).End(3).Row With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With '-------------- Delete all sheets Except the Main sheet Application.DisplayAlerts = False For Each sh In Sheets If sh.Name <> S.Name Then sh.Delete End If Next Application.DisplayAlerts = True '-------------------------------------- m = Ro \ tt n = (Ro Mod tt) m = IIf(n = 0, m, m + 1) ReDim arr(1 To m) arr(1) = 2: arr(2) = tt For x = 3 To m arr(x) = arr(x - 1) + tt Next For i = 1 To m S.Copy After:=Sheets(i) With ActiveSheet .Name = S.Name & i .Range("a1").CurrentRegion.Offset(1).Clear S.Range("A" & arr(i)).Resize(tt, 17).Copy .Cells(2, 1).PasteSpecial .Shapes.Range(Array("But_1")).Delete .Range("a1").Select End With Next i With Sheets("Salim" & m) max_ro = .Cells(Rows.Count, 1).End(3).Row If max_ro = 1 Then Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True ElseIf max_ro < tt + 1 Then .Range("A" & max_ro + 1).Resize(tt, 17).Clear End If End With With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic .CutCopyMode = False .DisplayAlerts = True End With S.Select: S.Range("a1").Select End Sub File Included Taksim_By_10.xlsm

وعليكم السلام ورحمة الله وبركاته مثلا عندك كومبوبوكس اي مربع تحرير وسرد باسم Combo1 غير خاصية locked له الى نعم واستخدم هذا الكود Private Sub Combo1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Me.Combo1.Dropdown End Sub اليك المثال كومبوبوكس.accdb

استاذى / @أحمد الفلاحجى اللهم امين سعيد جدا كونى كنت السبب فى ضحكة لك

تم ارفاق الملف مرة اخرى ، بعد التعديل 🙂 الاخ اسامة ارفق البرنامج كاملا ، بينما نحن بحاجة الى جداول ونماذج معينة ، علشان نعرف سبب حجم البرنامج 🙂 جعفر

اتفضل اليك هذا Private Sub first_date_AfterUpdate() Dim i As Integer Dim firDat As Date Dim YeNum As Integer firDat = Me.first_date YeNum = Me.yeart_no If Len(Me.yeart_no & "") = 0 Then Exit Sub For i = 0 To 2 Me.yeart_no = YeNum + i Me.first_date = DateAdd("YYYY", i, firDat) Me.end_date = DateAdd("YYYY", i, firDat) - 1 DoCmd.GoToRecord , , acNewRec Next i End Sub قمت بتغير حقل year_no من النصي الى رقمي وستكتب فيه الرقم بدل ان تكتب الرقب كتابية اليك الملف الاجازات (2).accdb

.الله يسلمك اخي العزيز ابو بسمله .. أنت النور كله الله يحفطك

هو المطلوب يسر الله أمرك

السلام عليكم ورحمة الله جرب المرفق لعل فيه ما تريد... إيجاد درس المراجعة.xlsx

مثال صغير بأفكار متعددة لفحص وتنظيم إدخالات التاريخ آخر مشاركة لي في هذا الموضوع DateValidation.rar

لا ضرورة لرفع ملف من اكثر من 2000 صف يكفي نموذج بسيط (في الملف المرفق حوالي 130 صف )فقط لمعايتة الماكرو يمنكنك اضافة اي عدد من الصفوف في الورقة Toullab شرط عدم ترك خلايا فارغة في الصفوف حيث يعمل الفلتر ( الرابع السادس والسابع) شخصياً لا افضّل تسمية الشيتات باللغة الغربية لصعوبة كتابة الكود ونقله الكود Option Explicit Sub My_FILTER() Rem Created by Saliom Hasbaya on 14/4/2020 With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim T As Worksheet, S As Worksheet Dim T_Table As Range, mr As Range, era As Range Dim i%, lr%, x%, Homany%, k%, y% Dim arr Set T = Sheets("Toullab"): Set S = Sheets("Statics") arr = Array("الاول", "الثاني", "الثالث", "الرابع") Set T_Table = T.Range("A1").CurrentRegion If T.AutoFilterMode Then T_Table.AutoFilter lr = S.Cells(Rows.Count, 1).End(3).Row With S.Range("C4:D" & lr - 1) .ClearContents .Offset(, 3).ClearContents .Offset(, 6).ClearContents .Offset(, 9).ClearContents End With y = 2 For k = 0 To 3 For i = 4 To lr - 1 '++++++++++++++++++++++++++++++++++++ T_Table.AutoFilter 6, S.Cells(i, 1) T_Table.AutoFilter 7, arr(k) T_Table.AutoFilter 4, S.Cells(2, 3) Set mr = T_Table.SpecialCells(xlCellTypeVisible).Offset(1) For Each era In mr.Areas x = Application.CountA(era.Columns(7)) If x Then Homany = Homany + era.Rows.Count End If Next S.Cells(i, 1).Offset(, y) = Homany - 1: Homany = 0 '************************************************************ T_Table.AutoFilter 4, S.Cells(2, 4) Set mr = T_Table.SpecialCells(xlCellTypeVisible).Offset(1) For Each era In mr.Areas x = Application.CountA(era.Columns(7)) If x Then Homany = Homany + era.Rows.Count End If Next S.Cells(i, 1).Offset(, y + 1) = Homany - 1: Homany = 0 Next i y = y + 3 Next k If T.AutoFilterMode Then T_Table.AutoFilter With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With Set T = Nothing: Set S = Nothing Set T_Table = Nothing Set mr = Nothing: Set era = Nothing End Sub الملف مرفق OH_my_filter.xlsm

السلام عليكم-تم انشاء صفحة جديدة بالملف (إدخال البيانات) وتم عمل قائمة منسدلة بالعمود الثانى B بأرقام السيارات , فكل ما عليك فعله هو اختيار رقم السيارة من القائمة وسيقوم الإكسيل بإظهار اسم السائق لتلك السيارة تلقائياً دون تدخل منك وذلك بهذه المعادلة... فمن فضلك لا تقوم بعمل دمج للخلايا لحسن عمل المعادلة =IFERROR(INDEX(الناقلين!$B$3:$B$1000,MATCH($B2,الناقلين!$C$3:$C$1000,0)),"") الناقلين.xlsx

وعليكم السلام 🙂 نعم هذا صحيح ، فيجب ان لا نستعمل الكلمات المحجوزة للاكسس ، وهنا قام اخوي ابوخليل بوضع مرفق للأسماء المحجوزة ، فيه كذلك رابط مُعرّب : جعفر

السلام عليكم من الكود يظهر ان لديك حقل ياسم name اذا كان ذلك صحيح فغير اسم الحقل لانه من الكلمات المحجوزة وارجو من اساتذتنا الكرام التعليق على ذلك وتوجيهنا

أستاذ الدهشوري لما لا تقوم بالضغط على الإعجاب لهذه الإجابة الممتازة ؟!!!💙 والله استعجب واستغرب كثيرا لهذا الأمر ... هل هذا تعالى وكبرياء ام ماذا ؟!!! طالما انك تحصلت على ما تريد وكان هذا بفضل ربنا وفضل الأستاذ نبيل عبد الهادى ,لماذا لا تقدم له أقل شيء مطالب ان تقدمه له مقابل حل مشكلتك وهو الضغط على الإعجاب له على حله لمشكلتك ؟

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

السلام عليكم استمر على الخط 128 ، غالبا جميع اجهزة الباركود تقرأه

جزاك الله خيرا ألف مليون شكر

طريقة اخرى بالكود ... ستجد جميع ماطلبته في شيت التمويل بالاعتماد على البيانات في شيت يومية الخزينة المعادلة :- النقد الفعلي في الخزينة = ( صافي النقد في الخزينة ( اجمالي التمويل + اجمالي الايرادات - اجمالي المصروفات )) + ( اجمالي العهد ) يومية خزينة2020.xlsm

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

http://www.mediafire.com/file/bgrg9c5y6l3e3gr/%D8%AE%D8%B7%D9%88%D8%B7_%D8%B9%D8%B1%D8%A8%D9%8A%D8%A9.rar/file

أتفضل https://www.sheetlabels.com/labels/templates

اسم الخط المستخدم DecoType Naskh Variants

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

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

السلام عليكم ورحمة الله وبركاته جمعة مباركة للجميع التعديلات الجديدة : 1ـ عندما تريد تعديل حساب اثناء اختيارك لرقم الحساب تاتيك معطيات هذا الحساب في الفورم لتختار منها ما تريد تعديله 2ـ حساب المتاجرة وارباح وخسائر والميزانية الختامية تم ضمهم في ورقة واحدة وسميت الاغلاق اذا اردت اقفال حساباتك تذهب الى ميزان المراجعة الذي يوجد فيه زر الانتقال اليها ثم ....... في النظر كفاية عن الشرح 3ـ زر جديد في القيود للصق قيمة العملة بمعطيات قيمته بالعملة الرئيسية 4ـ زر لصق فارق الميزان يقوم باحتساب الفرق للعملتين الرئيسية والفرعية 5ـ فورم اضافة التاريخ ( هدية الاخ نزار) للتذكيراسم المستخدم : خبور كلمة المرور : بسم الله كلمة مرور التعديلات : بسم الله وترقبوا قريبا ان شاء الله برنامج خبور بالتاريخ الهجري ودمتم في حفظ الله وسلامته تحياتي وسلامي اخوكم / خبور __________________________.rar