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

بالإضافة إلى طريقة أخي ِAbo_El_Ela 🙂 اعمل استعلام .. وأحضر جميع الحقول بالضغط على النجمة .. ثم أضف حقل الترقيم التلقائي وأزل علامة الصح من أسفله واجعل الترتيب تنازلي .. ثم إجعل القيم العليا من صندوق خصائص الاستعلام = 1

استاذي الكبير موسي بارك الله في علمك معلومة جديده بالنسبة لي بارك الله في علمك

على كل حال استبدل الكود الموجود في الزر بهذا ..................................... Call GetWaiting("Please wait ... data is processing") On Error Resume Next Dim db As DAO.Database Dim rstFrom As Recordset Dim rstTo As Recordset Set db = CurrentDb() Dim RC, i, r, rr As Integer Set rstTo = db.OpenRecordset(Me.Combo15, dbOpenDynaset) Set rstFrom = db.OpenRecordset("tblTemp", dbOpenDynaset) CurrentDb.Execute ("Delete * From tblTemp") rstFrom.MoveFirst: rstFrom.MoveLast RC = rstFrom.RecordCount rstFrom.MoveFirst For i = 1 To RC rstTo.AddNew For r = 0 To rstFrom.Fields.Count - 1 For rr = 0 To rstTo.Fields.Count - 1 If rstFrom.Fields(r).name = rstTo.Fields(rr).Properties("Caption") Or rstFrom.Fields(r).name = rstTo.Fields(rr).name Then rstTo.Fields(rr) = rstFrom.Fields(r) End If Next rr Next r rstTo.Update rstFrom.MoveNext r = 0 rr = 0 Next i DoCmd.Close acForm, "frmWaiting" rstTo.Close rstFrom.Close Set rstTo = Nothing Set rstFrom = Nothing Set db = Nothing طبعا هذا الكود بيتعرف على اسم الحقل واذا وجد اسم الحقل مختلف ينتقل الى التسمية التوضيحة للحق لتنفيذ امر نقل البيانات للجدول ................

اعمل استعلام و دوس علي اجماليات و في عمود الترقيم التلقائي افتح تجميع حسب و غيرها لـ max

وعليكم السلام ..بسيطة وسهلة , بما انك لم تقم بوضع القيمة صفر فى الأعمدة فكان لزاماً عليك تغيير الصفر بالفراغ داخل المعادلة "" لتصبح المعادلة هكذا وشكراً =COUNTIFS($C$1:$C$2400,"<>"&"",$A$1:$A$2400,$J4) Countifs الحل1.xlsx

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

تكملة على عمل أخي محمد البرناوي 🙂 Dim x As Integer ' عدد السجلات الغير معلم عليها صح x = DCount("[ck]", "[student_wezara]", "[ck] =0") iF X > O Then MsgBox " عدد السجلات الخطأ هي " & x & " سجل ", vbInformation, "سجلات" Else 'عدد السجلات 0 لذلك سيتجاهل الإشعار End IF

السلام عليكم و رحمة الله ..استخدم هذا الكود Sub NoZiro() Dim ws As Worksheet, Lr As Long, p As Long, j As Long Dim Arr As Variant, Temp As Variant, i As Long Set ws = Sheets("ورقة1") Lr = ws.Range("B" & Rows.Count).End(3).Row Arr = ws.Range("B2:G" & Lr).Value ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) If Arr(i, 5) <> 0 And Arr(i, 5) <> "" Then p = p + 1 For j = 1 To 6 Temp(p, j) = Arr(i, j) Next End If Next If p > 0 Then ws.Range("O2").Resize(p, UBound(Temp, 2)).Value = Temp End Sub

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

نعم أستاذى الكريم ولكن ان لابد ان تسبقها علامة لا تساوى داخل علامة التنصيص "<>"

بارك الله فيك ..اذن اذا كان البحث في خلايا قيمتها صفر نضع صفر ..واذا كان قيمتها فارغة ""

اجعل القيمة في الخلايا الفارغة 0 في العمود c

وعليكم السلام -تفضل لأن ذلك بسبب انك بالنسبة لشهور السنة الموجودة بالقائمة المنسدلة انت عاملها عام 2021 ..فقد تم تغييرها الى 2022 ..وأما بالنسبة لما لا يظهر معك من عقوبة ومهمة وذلك لأنك عامل نطاق القائمة المنسدلة حتى الصف الخامس فقط أما هذان الإختياران فموجودان حتى الصف السابع فقد تم التعديل وشكراً .. والشرح كما بالصور , حتى يتم غلق المشاركة .. أما بالنسبة لموضوع الترحيل فلابد من فتح مشاركة وموضوع جديد فهذا لا يتم الا بكود ولابد من رفع الملف بإمتداد يقبل إضافة الأكواد وهو Xlsm كشف حضور 1مميز.xlsx

شكرا جدا ليك اخي @Moosak لقد تم حل المشكله

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

أكتب x>0 وليس c .. أنت الآن كتبت x=1 وتعني إن كان عدد الأذونات يساوي واحد يعطيك تنبيه .. لكن إذا زادت عن الواحد لن تعمل معك ..

لا علم لي بهذه الطريقة .. مع إيماني بإمكانية تطبيقها في الأكسس. 🙂✋🏻

السلام عليكم و رحمة الله الكود يعمل على نفس الملف و لا يصلح لملف خارجى اذا اردت عملية اللصق فى مكان آخر فقم باستبدال هذه العبارة : If p > 0 Then ws.Range("O2").Resize(p, UBound(Temp, 2)).Value = Temp بهذه العبارة : If p > 0 Then ActiveCell.Resize(p, UBound(Temp, 2)).Value = Temp

برنامج Generate QR Code إنشاء رمز الاستجابة السريعة لاحظت في الفترة الاخيرة عدة طلبات تدور حول QR Code لحاجته بالفواتير الاكترونية وهو عبارة عن كود يضم اسم السلعة او الخدمة وسعرها او حسب الحاجة اليه وما يحتويه من بيانات عن الخدمة او المنتج . البرنامج سهل ويسير ويمكن تعديله بسهولة بما يتناسب الاحتياجات المختلفة شرح البرنامج البرنامج لا يحتاج اضافة اي خطوط للويندوز يعمل من خلال https://developers.google.com/chart/infographics/docs/qr_codes تحديدحجم الكود(الطول ×العرض) من خلال QR Code Size الخيارات المتاحة اولا : لاستخدامه علي سلعة واحدة نختار حجم الكود من خلال QR Code Size القيمة الافتراضية 1 دبل كليك علي اسم السلعة في الليست بوكس ثم نضغط علي Generate In Sheet لتوليد الكود امام السلعة في نفس الشيت ثانيا: لاستخدامه علي كافة السلع او الخدمات مرة واحدة لاختيار الجميع نختار All قم Generate In Sheet ثالثا : لتصدير الكود كصورة بامتداد JPG لتصدير كود لسلعة واحدة نفس الخطوات السابقة دبل كليك علي السلعة ثم Save QR لتصدير الكود لجميع السلع مرة واحدة نختار All ثم Save QR المجلد لحفظ نفس مسار الملف داخل مجلد Dahy اتمني ان تكون فيه الفائدة مع تحياتي الملف بالمرفقات ملف مضغوط يحتوي علي البرنامج ومجلد حفظ ال QRCode QR Code Dahy Algharieb.rar

في حدث عند فتح النموذج ضع هذا الكود ........................ مع تعديل بيانات الكود حسب جدولك وحقل CHEK Dim x As Integer x = DCount("[ck]", "[student_wezara]", "[ck] =0") MsgBox " عدد السجلات الخطأ هي " & x & " سجل ", vbInformation, "سجلات"

تحية طيبة في المرفقات حل أولي لما تريده مع بعض التعديلات على الملف (تعديل على التنسيقات، إضافة جداول مساعدة، وضع المعادلات المناسبة للمطلوب).... محمد درويش.xlsx

جزاك الله خيراً أخي (محمد أحمد لطفي) جعله الله في ميزان حسناتك

السلام عليكم قم بجمع كل الأعداد المتوفرة ثم تقسيم الناتج على الخلايا كلها... والملف الذي أدرجته في المرفقات لا يفي المطلوب جيدا...

اضافة منى ممكن تساعد دى الاوامر و الملف المرفق بالضغط عليه يقوم بالتنفيذ @echo off del /s /f /q c:\windows\temp\*.* rd /s /q c:\windows\temp md c:\windows\temp del /s /f /q C:\WINDOWS\Prefetch del /s /f /q %temp%\*.* rd /s /q %temp% md %temp% cls تنظيف التمب.rar

وعليكم السلام ورحمة الله تعالى وبركاته هناك عدة طرق منها اختيار خانة معينة مثال لنفترض ان اسم الماكرو هو (Macro3) سيتم اعادة التشغيل للماكرو بشرط القيمة الموجودة في الخلية A1 Sub test1() Dim i As Long For i = 1 To Range("A1").Value Macro3 Next i End Sub كما يمكنك ادخال عدد التكرار يدويا بهده الطريقة Sub test2() Dim i As Long Dim N As Variant N = InputBox("اختر عدد مرات التكرار") If Not IsNumeric(N) Then Exit Sub For i = 1 To N Macro3 Next i End Sub اليك ملف للتجربة test_macro.xlsm

السلام عليكم و رحمة الله ربما تقصد هذا Sub TrData() Dim ws As Worksheet, sh As Worksheet Dim LR As Long, x As Integer Dim a As Double, Knd As String Dim C As Range Set sh = Sheets("Search") Set ws = Sheets("Data") a = sh.Range("A1"): Knd = sh.Range("B1") LR = ws.Range("A" & Rows.Count).End(3).Row For Each C In sh.Range("A3:A22") On Error Resume Next x = WorksheetFunction.Match(C, ws.Range("C1:X1"), 0) If ws.Cells(1, x + 2) = C.Value Then ws.Cells(LR + 1, 1) = Knd ws.Cells(LR + 1, 2) = a ws.Cells(LR + 1, x + 2) = C.Offset(0, 1) End If Next End Sub

السلام عليكم .. اخوانى الكرام ,, بعد التحية موضوعنا اليوم عن النسخ الاحتياطى لمحتويات فولدر محدد فى وقت محدد من اليوم على اساس يومى او اسبوعى او شهرى كما تريد . قمت بتصميم نموذج فى القاعدة المرفقة يتم تحديد فيه الفولدر المطلوب نسخه و مكان حفظ النسخة والوقت الذى يتم فيه النسخ تلقائيا . كود النسخ المستخدم كالتالى : Public Sub Copy_Folder1() Dim FSO As Object Dim FromPath As String Dim ToPath As String FromPath = Forms!Frm!from 'ToPath = "D:\Old\test" '<< Change ToPath = Forms!Frm!To2 & Format(Now, "yyyy-mm-dd h-mm-ss") If Right(FromPath, 1) = "\" Then FromPath = Left(FromPath, Len(FromPath) - 1) End If If Right(ToPath, 1) = "\" Then ToPath = Left(ToPath, Len(ToPath) - 1) End If Set FSO = CreateObject("scripting.filesystemobject") If FSO.FolderExists(FromPath) = False Then MsgBox FromPath & "المسار المطلوب النسخ منه غير موجود" Exit Sub End If FSO.CopyFolder Source:=FromPath, Destination:=ToPath End Sub مميزات الكود : نسخ محتويات الفولدر بالكامل سواء ملفات او فولدرات فرعية . فى حالة عدم وجود المسار المطلوب وضع النسخة الاحتياطية فيه سيقوم بانشاءه تلقائياً. فى حالة وجود المسار وبه ملفات بنفس الاسم سيتم عمل Overwrite للملفات القديمة واستبدالها بالجديدة (وذلك فى حالة انك غيرت الاسم الذى يتم الحفظ به لأن الافتراضى يحفظ الاسم بالتاريخ ووقت الحفظ بالدقائق وبالتالى من الصعب تشابه الاسماء بين النسخ). شكل النموذج عند الضغط على تشغيل يقوم باستدعاء كود النسخ . فى حالة وصول وقت الجهاز الى الوقت المحدد بالنموذج يقوم باستدعاء كود النسخ . يمكنك كتابة المسار او اختياره عن طريق الازرار الموجودة بجوار الحقل النصى. لحد الآن موصلناش لجزئية التلقائى المذكورة فى العنوان 😅, من المعروف ان لازم تكون القاعدة مفتوحة حتى يعمل النسخ الاحتياطى وبالتالى فى حالة انك قمت بعمل استيراد للبرنامج ده داخل قاعدتك الاساسية المفتوحة طوال اليوم فلا مشكلة وعند وصول الوقت المحدد ستعمل بدون مشاكل .. ولكن ماذا لو اردت ان النسخ يتم حتى لو القاعدة مغلقة ؟ سنقوم بالاستفادة بخاصية مهمة موجودة فى الويندوز وبدون استخدام برامج خارجية تابع معى : فى قائمة Start ابحث عن Task Scheduler وهى خاصية تقوم بعمل مجموعة من الاوامر فى اوقات محددة مثل تشغيل برنامج او اغلاقه او ارسال ايميل مثلا الخ... هذه صورة الواجهة اضغط على Create Basic Task وستفتح لك الواجهة التالية : اكتب اسم المهمة المطلوبة ثم Next : هنا تكرار المهمة يوميا - اسبوعيا - شهريا - مرة واحدة - عند بداية التشغيل للجهاز - عندما اسجل دخول المستخدم - عند حدوث حدث معين . اختر ما يناسبك وفى حالتنا اخترت Daily يومياً . اختر تاريخ بداية العمل و الوقت المطلوب تشغيل المهمة فيه .التالى فى هذه الخطوة تختار ماهية المهمة فتح برنامج معين - ارسال ايميل - عرض رسالة محددة .. اختر Start Program فى حالتنا .. التالى فى هذه الخطوة تقوم باختيار مسار البرنامج المطلوب تشغيله وطبعا فى هذه الحالة البرنامج هو ميكروسوفت اكسس يتم تحديد مسار البرنامج من "C:" ثم تحديد القاعدة المطلوب تشغيلها فى Arguments بنفس الصيغة الموجودة بالصورة (بين علامتين تنصيص والمسار كامل بالامتداد ) #Program/Script "C:\Program Files\Microsoft Office\Office16\MSACCESS.EXE" #Arguments "C:\Users\Amr\Access\Backup\Tasker.Accdb" ثم اضغط على Finish. وبهذا قمنا بعمل مهمة للويندوز انه يفتح القاعدة الخاصة بنا فى وقت معين يومياً ,, باقى العمل داخل القاعدة نفسها كالتالى : فى حدث عند الفتح للنموذج ستجد الكود التالى : Private Sub Form_Open(Cancel As Integer) DoCmd.GoToRecord , , acFirst Me.To2 = [to] & "\" & [newnm] & " " Call SixHatHideWindow(SW_SHOWMINIMIZED) 'Call Copy_Folder1 '''' نقوم بتفعيل الخيار بعد تحديد الخيارات فى النموذج اول مرة لتعمل بتلقائية فيما بعد 'DoCmd.Quit '''' نقوم بتفعيل الخيار بعد تحديد الخيارات فى النموذج اول مرة لتعمل بتلقائية فيما بعد End Sub السطرين الغير مفعلين يتم تفعليهم بعد تحديد الخيارات الخاصة بيك من النموذج اول مرة وعند تفعيلهم بمجرد تشغيل القاعدة ستقوم بعملية النسخ وتغلق تلقائياً .. وبالتالى ملخص الفكرة ان القاعدة هتكون مغلقة وهتقوم مهمة الويندوز بتشغيلها وعند تشغيلها ستقوم بعمل النسخ الاحتياطى بالبيانات التى تم تحديدها اول مرة ثم تغلق تلقائياً وذلك فى اقل من ثانية قد لا تلاحظها من الاساس . مرفق القاعدة .. جرب ووافنى بالنتيجة .. دمتم بخير. ملحوظة : يمكن عمل المهمة الخاصة بالويندوز عن طريق اسكريبت VBS اختصارا للخطوات ولكن اردت شرح الفكرة من أساسها ويكون هناك مساحة للتطوير فيما بعد . BackupManual+Auto+Timer-AmrAshraf.accdb

وعليكم السلام اهلا بك في المنتدى -الرابط موجود في مشاركة الأستاذ ضاحى الغريب صاحب الموضوع بارك الله فيه وجزام الله عنا كل خير وزاده الله من فضله وتفضل الملف مرة اخرى KG_VII_B_Dahy.rar

السلام عليكم أخي العزيز أرجو الإلتزام مستقبلا بقواعد المشاركة سأغير العنوان حتي لايحذفه احد المشرفين مرفق مثالا وبه الشرح أرجو من الله ان أكون وفقت في شرح الدالة تفضل المرفق TAX02.rar