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

في هذا السطر If cll < 15 & cll > 0 Then يوجد خطا استبدل & ب and او or مثل هذا If cll < 15 and cll > 0 Then

السلام عليكم 🙂 هذا المنتدى للتبادل العلمي ، حتى يستفيد منه الجميع ، وليس صاحب الموضوع / السؤال فقط 🙂 فيا ريت ان نضع الاجابة بالتفصيل في الرد (سواء الخطوات او الكود او صور من شاشة البرنامج) ، ولا نتوقف عند ارفاق المرفق الذي به الرد / الجواب ، والسبب هو ، حتى يستطيع الجميع رؤية الرد ومعرفته مباشرة ، دون اللجوء الى انزال المرفق وفهمه 🙂 نعم ، هذا عبء إضافي ، ولكن نتائجه ستكون مثمرة ان شاء الله 🙂 وتذكروا ، هذا مجرد طلب ورجاء ، وليس اجباري 🙂 شكرا جزيلا 🙂 جعفر

على حسب فهمي يجب تغيير العنوان واستبداله ب حدف الصفوف الفارغة جرب هذا الشي البسيط لاحظ اعتمدت على العمود c ما دام دائما فارغ كبقية الاعمدة فلم اشير الى بقية الاعمدة Sub DeleteRows() Intersect(Columns("c"), ActiveSheet.UsedRange).SpecialCells(xlBlanks).EntireRow.Delete End Sub

ارى ان تقومي بوضع النتائج المتوقعة يدويا حتى يستطيع بقية الاعضاء مساعدتك 😎

Book1 (2).xlsM

لماذا تكرر هذا الموضوع واعتقد ان الاخ محمد اجابك وقمت بالاعجاب يعني قام بحل الموضوع https://www.officena.net/ib/topic/113326-تسمية-الملف-بإسم-الأسبوع-والسنة-تلقائيا-عند-الحفظ/ كان وجب عليك اما الرد بالسلب او الايجاب اذا اردت المساعدة من الاخرين .

يوما ما ، انا احتجت الى مثل هذا التذكير ، وبعد البحث ، اتضح لي ان الاكسس ليس الاداة المناسبة لهذا العمل ، نعم يمكن تطويعه ، ولكن هناك ادوات افضل ، خليني اشرح الفرق : في الاكسس ، يجب عمل كود لتفقد ساعة الوندوز ، كل دقيقة مثلا ، ولكن هذا الكود واقعا يجعل الاكسس يعمل طوال الوقت في الخلفية ، فهو يتاكد من انتهاء الدقيقة ، وبعدها ينظر للكود لعمل المطلوب. وحتى لو عملت هذا البرنامج ، فسيكون في نسخته الاولى 🙂 بينما هناك برامج للوندوز ، تعمل بساعة الوندوز (حتى والاكسس مغلق) ، ولا تستهلك قوى اضافية من المعالج CPU ولا يأخذ ذاكرة RAM زيادة ، وقد جربه الكثيرون ، ووصلوا بالتعديل عليه الى النسخة الفلانية. اليك روابط بعض هذه البرامج المجانية: https://www.microsoft.com/en-us/p/hourly-reminder/9nblggh0d6rb?activetab=pivot:overviewtab# https://www.wisecleaner.com/wise-reminder.html وقائمة عن برامج اخرى مجانية https://techwiser.com/9-best-reminder-apps-for-windows وقد قام الاخ @Amr Ashraf بعمل موضوع ، ويمكن الاستفادة منه مباشرة لغرضك ، وبدون اكواد ، مجرد اختيارات : ولا ننسى الهاتف الجوال ، فهو كمبيوتر متنقل وشغال 24 ساعة ولا يفارقنا ، وهذا رابط لبرنامج للاندرويد : https://play.google.com/store/apps/details?id=com.kittoboy.repeatalarm&hl=en_US&gl=US قد يكون احتياجك يضطرك لإستخدام الاكسس ، فإن كان كذلك ، فأتمنى ان يهب الاعضاء ممن له الخبرة في هذا المجال للمساعدة 🙂 جعفر

اخي هل تريد التاريخ هكذا DATE(1443;10;1) = ممكن توضح الصيغة المطلوب الحصول عليها مثلاً التاريخ 1/10/1443

اخي بالفعل بيتم نسخ اي بيانات ظاهرة لان طلبك غير مفهوم اخي من فضلك اقفل هذه المشاركة وقم بطلب باقي طلبك في مشاركه اخري انظر بعد النسخ

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

شكرا جزيلا ....🥰 الطريقة التي قمت بسردها اوحت لي فكرة اخري قمت بتجربتها و نجحت معي بنسبة 100% انا لا اريد فرز و تصفية علي نوع الحساب ( هذا لا يعنيني في شئ) المهم بالنسبة الي هو العميل الذي قام بعمليات الايداع تلك و بناء علي ذلك قمت بتعديل الصفوف ليظهر لي اسماء جميع العملاء في المقدمه هنا حل حل مشكلتي شكرا جزيلا مرة اخري ... مجهود تشكر عليه ..... و الله ينور عليك يا غالي

الحمد لله الذي بنعمته تتم الصالحات

الاخت مريم2 السلام عليكم يرجي توضيح اكثر مثلاً 1: تريدي ان تبحثي عن موظف ويتم استدعائة واستدعاء بياناته 2: اما تريدي اخذ نسخة من البيانات ووضعه بجواره من فضلك يرجي التوضيح جزاكي الله خيراً

من ال Row Source قم باختيار الاستعلام Q_tbl-bb وانزل جميع الحقول ومن ال Format اجعل عدد الاعمدة 8 ثم اختر عرض مناسب لكل عمود تحياتي

ارفع ملف للعمل عليه وانت تريد لما يتم اختيار الاصول يكتب تحت رقم الكودي للاصول ؟

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

المعلومة جديدة بالنسبة لي ايضا

رائع شكرا على تفاعلك 😉

اخيرا نعم اخي عبدالفتاح في بي اكسيل ضبط الف شكر لكم جميعاً ما قصرتوا انت والاخ محمد يوسف ابو يوسف

@محمد بن صالح اعتقد انك محق بخصوص الخطا جرب هذا سيعمل معك قم بتغيير من ActiveWorkbook.SaveAs Filename:="E:\التقرير لتاريخ" & "\العمل " & Format(Date - 1, "DD-MM-YYYY") & ".xlsm", _ FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False الى ActiveWorkbook.SaveAs Filename:="E:\التقرير لتاريخ" & "\العمل " & Format(Date - 1, "DD-MM-YYYY") , _ FileFormat:=51, CreateBackup:=False

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

تفضل جرب Course certificates -Mohd+Moosa.zip

وعليكم السلام 🙂 حيا الله اخوي محمد 🙂 في الواقع عمل هذا النوع من المجاميع في الجدول او الاستعلام ، يبطئ عمل الجدول والاستعلام ، ولا ارى فائدة منه ، إلا اذا تسمح للمستخدم ان يرى البيانات في الجدول ، وهذه كارثة 😱 جعفر

وعليكم السلام استخدم الكود التالي في مربع النص =DSum("[Amount]";"M")

تفضل برنامج مراجعة فواتير العلاج الشهرى المزمن..rar

Use IFERROR function

شكرا جزيلا ... و لكن ليس هذا الحل الذي اريده ومرفق صور للتوضيح

ربما Sub test() With Sheets("B") a = Join(Application.Transpose(.Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)))) b = Join(Application.Transpose(.Range(.Cells(2, 2), .Cells(2, 2).End(xlDown)))) End With With Sheets("C") a1 = Join(Application.Transpose(.Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)))) b1 = Join(Application.Transpose(.Range(.Cells(2, 2), .Cells(2, 2).End(xlDown)))) End With a = Split(a & " " & a1): b = Split(b & " " & b1) With CreateObject("scripting.dictionary") For i = 0 To UBound(a) If Not .exists(a(i)) Then .Add a(i), b(i) Next a = Application.Transpose(Array(.keys, .items)) End With Sheets("A").Cells(2, 1).Resize(UBound(a), 2) = a With Worksheets("A").Sort Worksheets("A").Sort.SortFields.Clear Worksheets("A").Sort.SortFields.Add2 Key:=Range("A2:A" & UBound(a) + 1), _ SortOn:=xlSortOnValues, Order:=xlAscending .SetRange Range("A2:b" & UBound(a) + 1) .Header = xlGuess .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub

وعليكم السلام 🙂 علشان تختار اكثر من اسم ، عندك اختيارين: 1. السجل تعمل فيه حقل iSelect من نوع نعم/لا ، ثم تعمل نموذج مستمر ، ويمكنك ان تختار اكثر من سجل/اسم. 2. تعمل مربع خيار ListBox ، ثم تجعل خيارات . فتستطيع بالنقر مرة على الاسم ان تختاره او تلغي الاختيار . وتضع احد الاختيارين في نموذج رئيسي ، وتعمل بقية الحقول المطلوبة ، والتي لا تكون مرتبطة بجدول ، وبعد اختيار الاسماء وتعبئة الحقول ، يكون عندك زر لتفريغ هذه البيانات في الجدول لهذه الاسماء ، سواء ان تُلحق سجل جديد ، او تعمل تحديث لسجل موجود ، كود الزر يعمل حلقة دوران للاسماء ، ويُدخل بيانات الحقول 🙂 جعفر

لا حظ اخي الحبيب الكود IIf(IsNull([D_ObsT]) And IsNull([Gr_Pro]);"X";"Y") هو المسؤول عن اظهار النتائج اضف له القيم الجديده للنتائج التي برغب بعرضها ثم لاحظ العلاقات يجب عند اضافة جدول جديد عمل لهة نفس الغلاقة اما اذا التبس عليك الامر ارشل مرفق و ان شاء الله انا او اي الموجودين بالخدمة واسئلك الدعاء لامي

اخي Hicham1470 تفضل طلبك هل هذا طلبكحفظ الملف بتاريخ اليوم.xlsm

السلام عليكم .. اخوانى الكرام ,, بعد التحية موضوعنا اليوم عن النسخ الاحتياطى لمحتويات فولدر محدد فى وقت محدد من اليوم على اساس يومى او اسبوعى او شهرى كما تريد . قمت بتصميم نموذج فى القاعدة المرفقة يتم تحديد فيه الفولدر المطلوب نسخه و مكان حفظ النسخة والوقت الذى يتم فيه النسخ تلقائيا . كود النسخ المستخدم كالتالى : 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

تفضل ابو يوسف Save As Text.xlsm

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

i didn't get what you mean exactly The code I posted is doing the same task as your code but keep the original workbook open. Please copy the code and insert it to a new module then go back to the worksheet then press Alt + F8 and run the code called "Test" and finally go to the partition d to see the text file output

Sub Test() Dim sName As String sName = Cells.Text & "D:\" & Cells(1, 2).Text & " Copy" & Format(Now, "-dddd-dd-mm-yyyy-") SaveWorkbookAs ThisWorkbook, sName, xlTextWindows End Sub Public Function SaveWorkbookAs(pWorkbook As Workbook, pFileName As String, pFileFormat As XlFileFormat) As Boolean Dim wFSO As Scripting.FileSystemObject, wWorkbook As Workbook, wScreenUpdating As Boolean, wEnableEvents As Boolean, wDisplayAlerts As Boolean, wTempName As String On Error Resume Next SaveWorkbookAs = False Set wFSO = New Scripting.FileSystemObject If pWorkbook Is Nothing Then GoTo EndFunction If (pFileName = vbNullString) Then GoTo EndFunction If (pWorkbook.FileFormat = pFileFormat) Then Err.Clear pWorkbook.SaveCopyAs pFileName SaveWorkbookAs = (Err.Number = 0) GoTo EndFunction End If With Application wScreenUpdating = .ScreenUpdating: .ScreenUpdating = False wEnableEvents = .EnableEvents: .EnableEvents = False wDisplayAlerts = .DisplayAlerts: .DisplayAlerts = False End With Err.Clear wTempName = wFSO.GetTempName pWorkbook.SaveCopyAs wTempName If (Err.Number > 0) Then GoTo EndFunction Err.Clear Set wWorkbook = Application.Workbooks.Open(wTempName, xlUpdateLinksNever) If (Err.Number > 0) Then GoTo EndFunction wWorkbook.SaveAs Filename:=pFileName, FileFormat:=pFileFormat SaveWorkbookAs = (Err.Number = 0) wWorkbook.Close SaveChanges:=False EndFunction: If (VBA.LenB(wTempName) > 0) Then If wFSO.FileExists(wTempName) Then wFSO.DeleteFile wTempName, True With Application .ScreenUpdating = wScreenUpdating .EnableEvents = wEnableEvents .DisplayAlerts = wDisplayAlerts End With Set wWorkbook = Nothing: Set wFSO = Nothing End Function From Tools > References: Microsoft Scriting Runtime

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

جرب المعادلة =SUMIF('2'!A4:A7,C3,INDIRECT("'" & E2))