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

السلام عليكم 🙂 عند عمل البرنامج ، لا تجرب برنامجك على عدد اقل من 10 الآف سجل ، فسرعة الاستعلام الصحيحة هي لما تجرب البرنامج على اكثر من 10 الآف سجل 🙂 لا تستعمل DlookUp او DSum واخواتها في استعلام ، لأنها تجعل الاستعلام بطيء ، واذا كانت البيانات كثيرة ، فالاستعلام سيكون بطيء بشكل غير مقبول !! وللعلم ، فالاوامر DlookUp او DSum هي واقعا استعلام ، ولكن تم عمله بهيئة دالة ، ترسل لها المتغيرات ، وترج لك النتيجة 🙂 والبديل هو فك كل امر DlookUp او DSum في استعلام مستقل (قد نستطيع جمعهم ، ولكن هذا يعتمد على المعايير) ، بحيث نستخدم معايير الاستعلام بدلا عن معايير الاوامر DlookUp او DSum ، ونستخدم ربط الجداول كنوع من المعيار كذلك. المثال التالي سيوضح قصدي: احد المؤسسات التي اتعامل معها ، ارسلت لي هذا الملف وبه حوالي مليون سجل ، وطُلب مني النظر في بطئ استعلام الحاقي. الجدول التالي يحتوي على 100 الف سجل (حذفت الباقي 🙂) ، وسجلات سنة 2019 = 7 سجلات فقط ، وبقية السجلات لسنة 2018 : . الاستعلام الالحاقي الاصل هو : . ومن اجل هذا المثال ، سنحول الاستعلام الى استعلام عادي ، وسنفك الحقول ، وسنستخدم مجاميع سنة 2019 في استعلام مستقل وكذلك لسنة 2018 : . بالنسبة لسنة 2019 ، بدل عن استخدام الامر DSum (سبب بطئ الاستعلام) ، سنفك الامر DSum الى استعلام مستقل ، هكذا : . ونفس الشيء لسنة 2018 ، والآن نأتي الى المعيار الاخير (3) ، وهو حقل id لجدول var ، يجب ان يساوي حقل المعرف لجدول data ، وانا هنا وضعت استعلام 2019 (والذي يحتوي على 7 سجلات كما رأينا اعلا) ، ووضعت الاستعلام 2018 كذلك ، فيصبح بهذه الطريقة : . هذا الاستعلام يأخذ حوالي ثانيتين في تنفيذه ، ورجاء تجربته 3 مرات للحصول على متوسط وقت التنفيذ 🙂 واترك لكم تجربة الاستعلام qry_DSum_Egaza_9 ، رجاء تجربته 3 مرات كذلك ، وكل من يشارك في هذا الموضوع ، رجاء اعطائنا وقت التنفيذ 🙂 رجاء لا تستخدم الكود في حساب الوقت ، وانما افتح الاستعلام يدويا ، 3 مرات 🙂 اما الاستعلام qry_DSum_Egaza_8 ، فلا انصحك بتجربته ، إلا اذا ما كان عندك شغل آخر تعمله 😁 جعفر استعمل سجلات هذا الملف لتجاربك: --------------------------------------------------------------------------------------------------- هذا مثال آخر يؤيد الفرق في سرعة الاستعلام بين الطريقتين : 1475.Dont_use_DlookUp_DSum_in_Query.accdb.zip

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

ضع هذا الكود في حدث عند وجود شوائب أو On Dirty للنموذج هكذا : Private Sub Form_Dirty(Cancel As Integer) Me.lastupdate = Now End Sub وأفضل أن تستخدم Now بدل Date .. ليعطيك التاريخ والوقت

اهلاً بالمعلم.. ابشر ولا يهمك، تفضل سورس الاداة بلغة VB.NET : Imports Google.Apis.Drive.v3 Imports Google.Apis.Drive.v3.Data Imports Google.Apis.Auth.OAuth2 Imports Google.Apis.Services Imports System.Threading Module GDU Dim ClientId As String = "" Dim ClientSecret As String = "" Dim ApplicationName As String = "" Dim FileName As String = "" Dim Extension As String = "" Dim FullPath As String = "" Dim CurrentPath As String = "" Dim IDFolderSave As String = "" Dim IsMessage As Boolean Dim IsCustomeFolder As Boolean ''' ########################################## ''' Application : Google Drive Uploader ''' Coded by : Dr.Hassanien (SEMO.Pa3x) ''' Date : 12-2-2022 ''' ########################################## Sub Main() Try Console.Title = "Google Drive Uploader - coded by Dr.Hassanien (SEMO.Pa3x)" Dim ARGS() As String For Each arg As String In My.Application.CommandLineArgs '--------------------------- '0 = Path '1 = ClientId '2 = ClientSecret '3 = ApplicationName '4 = FileName '--------------------------- ARGS = Split(arg, "~||~") 'split arg to parts FullPath = ARGS(0) Extension = System.IO.Path.GetExtension(FullPath).ToString.ToLower ClientId = ARGS(1) ClientSecret = ARGS(2) ApplicationName = ARGS(3) FileName = ARGS(4) IDFolderSave = ARGS(5) IsCustomeFolder = IIf(IDFolderSave = "", False, True) IsMessage = CBool(ARGS(6)) 'set new path CurrentPath = AppDomain.CurrentDomain.BaseDirectory & "BK" & Extension 'check exist path If System.IO.File.Exists(CurrentPath) Then System.IO.File.Delete(CurrentPath) End If 'copy to other location to use it System.IO.File.Copy(FullPath, CurrentPath) Next Console.ForegroundColor = ConsoleColor.Green Console.WriteLine("Upload process has started, please wait...") UploadFile(CurrentPath) Catch ex As Exception MsgBox(ex.Message) Console.ForegroundColor = ConsoleColor.Red Console.WriteLine(ex.Message) Console.ReadLine() End Try End Sub Private Service As DriveService = New DriveService Private Sub CreateService() Dim MyUserCredential As UserCredential = GoogleWebAuthorizationBroker.AuthorizeAsync(New ClientSecrets() With {.ClientId = ClientId, .ClientSecret = ClientSecret}, {DriveService.Scope.Drive}, "user", CancellationToken.None).Result Service = New DriveService(New BaseClientService.Initializer() With {.HttpClientInitializer = MyUserCredential, .ApplicationName = ApplicationName}) End Sub Public Sub SearchFolder() Try Dim findrequest As FilesResource.ListRequest = Service.Files.List Dim listFolder As Data.FileList = findrequest.Execute For Each item As File In listFolder.Files If item.MimeType = "application/vnd.google-apps.folder" Then If item.Id = IDFolderSave Then IDFolderSave = item.Id.ToString Exit For Else Console.ForegroundColor = ConsoleColor.Red Console.WriteLine("=============================================") Console.WriteLine("ERROR: Folder not found in google drive !") Console.WriteLine("=============================================") Console.ReadLine() End If End If Next Catch ex As Exception Throw ex End Try End Sub Private Sub UploadFile(FilePath As String) 'call service CreateService() 'check custome folder If IsCustomeFolder = True Then SearchFolder() End If Dim TheFile As New File() TheFile.Name = FileName & Extension TheFile.Description = "Description" 'check custome folder If IsCustomeFolder = True Then Dim plist As List(Of String) = New List(Of String) plist.Add(IDFolderSave) 'Set parent folder TheFile.Parents = plist End If Dim ByteArray As Byte() = System.IO.File.ReadAllBytes(FilePath) Dim Stream As New System.IO.MemoryStream(ByteArray) Dim UploadRequest As FilesResource.CreateMediaUpload = Service.Files.Create(TheFile, Stream, TheFile.MimeType) 'You were mmissing the Upload part! UploadRequest.Upload() Dim file As File = UploadRequest.ResponseBody System.IO.File.Delete(CurrentPath) If IsMessage = True Then Console.ForegroundColor = ConsoleColor.Green Console.WriteLine("") Console.WriteLine("") Console.WriteLine("") Console.WriteLine("=============================================") Console.WriteLine("File has been uploaded successfully....") Console.WriteLine("=============================================") Console.WriteLine("") Console.ForegroundColor = ConsoleColor.Gray Console.WriteLine("Press any key to exit...") Console.ReadLine() End If End Sub End Module

اعتقد هذا سيفي بالغرض Sub DeleteRows() With Columns("B:G") .SpecialCells(xlBlanks).Delete Shift:=xlUp .Rows(5).Copy .SpecialCells(xlBlanks).PasteSpecial xlPasteFormats End With Application.CutCopyMode = False End Sub

بعد اذن اخي وحبيبي في الله عبدالفتاح في بي اكسيل اخي Elsayeh تفضل طلبك ترحيل دون فراغ الملف كود الترحيل داخل الشيت.xlsm

Sub Test() Dim ws As Worksheet, sh As Worksheet, lr As Long, lc As Long, r As Long, c As Long, m As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets(1) Set sh = ThisWorkbook.Worksheets(2) sh.Range("B7:C100").ClearContents lr = LastRow(ws) lc = LastCol(ws) m = 7 For r = 4 To lr Step 2 For c = 1 To lc If ws.Cells(r + 1, c).Value <> "" Then sh.Cells(m, 2).Value = ws.Cells(r, c).Value sh.Cells(m, 3).Value = ws.Cells(r + 1, c).Value m = m + 1 End If Next c Next r Application.ScreenUpdating = True MsgBox "Done", 64 End Sub Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", After:=sh.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", After:=sh.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column On Error GoTo 0 End Function

Here's a file with 3000 rows File.xlsm

اعرض الملف ملف قاعدة بيانات اكسس يحتوي على 3,919,015 سجل ، لتجربة سرعة برنامجك السلام عليكم 🙂 لعمل برنامجك ، فلا يكفي ان تجربه على بضع سجلات ، وانما يجب تجربته على اكبر قدر ممكن من السجلات ، وخصوصا اذا كان برنامجك سيعمل في شبكة 🙂 لذا ، انزل هذا الملف الى مكتبتك ، واعمل منه نسخة لكل تجربة تريد تعملها 🙂 لا اذكر من اين انزلت هذا الملف ، ولكنه من الملفات المفيدة جدا 🙂 قاعدة البيانات هذه ، تحتوي على بيانات وهمية ، وحجم الملف المضغوط حوالي 30 ميجابايت ، بينما عند فك الضغط يكون حجم الملف حوالي 219 ميجابايت ، يمكن انزال برنامج مجاني من هذا الرابط لكي تفك ضغط الملف (انا استعمله كأحد برامجي الاساسية 🙂 ) : https://www.7-zip.org/ جعفر هنا رابط لمقارنة سرعة الحلول ، باستعمال هذا الكم من البيانات : صاحب الملف jjafferr تمت الاضافه 08 ديس, 2020 الاقسام قسم الأكسيس

السلام عليكم ورحمة الله وبركاته... عود على بدء في موضوعي هذا: اقدم لكم النسخة الثانية من اداة رفع الملفات ونسخ الباك اب الى Google Drive لكن هذه المرة ستقوم الاداة بضغط الملف وتشفيرة بباسورد بأستخدام winRAR ومن ثم رفعه الى Google Drive لمنع اي شخص من الاطلاع على محتويات الملف المضغوط لان الضغط هنا سيكون Encrypt File Names بعبارة اخرى سيكون الملف المضغوط هكذا شكله: لن تستطيع ان تعرف ما يحويه الملف المضغوط من ملفات الا اذا قمت بوضع الباسورد. اضفت براميتر جديد على الاداة وهو باسورد الضغط، ستجدون كل شيء في ملف الاكسس، وباقي الامور شرحناها في الدرس السابق لا تنسوني ووالدي من صالح دعائكم. تم بحمد الله. GoogleDriveUploader_fixed.rar

السلام عليكم.. اداة صغيرة مكتوبة كـ مفتاح registry عند تشغيلها ستقوم باضافة خيار جديد في الزر الايمن للماوس وضيفته جلب مسار الملفات والمجلدات لسرعه الوصول لها في البرامج او غيرها.. الاداة ليست من كتابتي انما فقط قمت بالتعديل عليها.. سورس الاداة: Windows Registry Editor Version 5.00 ; ########################################## ; Application : Get files/directories path by right click windows ; Coded by : Dr.Hassanien (SEMO.Pa3x) ; Date : 28-2-2022 ; ########################################## [HKEY_CLASSES_ROOT\Allfilesystemobjects\shell\windows.copyaspath] "CanonicalName"="{707C7BC6-685A-4A4D-A275-3966A5A3EFAA}" "CommandStateHandler"="{3B1599F9-E00A-4BBF-AD3E-B3F99FA87779}" "CommandStateSync"="" "Description"="@shell32.dll,-30336" "Icon"="imageres.dll,-5302" "InvokeCommandOnSelection"=dword:00000001 "MUIVerb"="@shell32.dll,-30329" "VerbHandler"="{f3d06e7c-1e45-4a26-847e-f9fcdee59be0}" "VerbName"="copyaspath" بعد تشغيل الاداة اضغط كلك يمين على اي ملف في الكومبيوتر او اي مجلد وستظهر لك: بعد نسخ اي مسار قم بلصقه، مثال: تحميل الملف من المرفقات لا تنسوني ووالدي من صالح دعائكم. تم بحمد الله. AddToRightClickWindows.rar

السلام عليكم أستاذتي محتاج إني افلتر على كل إدارة في ملف لوحده جزاكم الله خيراً Time Attendance Details Report 15022022_125100.xls

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

وعليكم السلام-يمكنك وضع هذا الكود فى حدث Thisworkbook بملفك ... فقط عليك بوضع اسم جهازك بالكود مكان ("Computername") بين القوسين .. وشكرا وهذا كود بسيط لمعرفة اسم جهاز الكمبيوتر لديك .عند وضع بمديول عادى Sub know() Msgbox ENVIRON("Computername") End Sub Private Sub Workbook_Open() Dim ChkName As String ChkName = MY - PC If Environ("Computername") <> ChkName Then MsgBox "File is only available to PC: " & ChkName, _ vbCritical + vbOKOnly, "Cannot Open File" Application.DisplayAlerts = False ThisWorkbook.Close Exit Sub Else MsgBox "PC security check passed.", vbOKOnly + _ vbInformation, "File Open Succesful" End If End Sub

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

اخي طارق 🙂 ما شاء الله عليك ، فعداد مشاركاتك يقول بانك اكملت 830 مشاركة ، ومعناها انك ادرى بطريقة عمل المنتدى 🙂 موضوعك السابق كان بعنوان : مساعدة في خطأ بالقاعدة بينما قوانين المنتدى تقول: 3. ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. وقد سبق تنبيهك وقفل احد/بعض مواضيعك سابقا !! وللعلم ، فإننا نغض الطرف عن الكثير من القوانين ، وخصوصا للمبتدئين 🙂 1. لو قرأت اسم الموضوع مرة اخرى بعد اغلاقه ، لوجدت ان اخونا ابوخليل وضح الامر: مساعدة في خطأ بالقاعدة _ ( العنوان مخالف) 2. من تجاربي ، معظم المواضيع التي لا يكون فيها رد ، معناه ، إما الموضوع صعب ، وإما ان الشرح مافيه تفصيل وامثلة ، فأنا مثلا ، اذا وجدت ان السؤال غير واضح ، اذهب الى موضوع آخر ، لكي استفيد من وقتي ، وللأسف ارى بعض الاسئلة وكأن السائل يتمنن علينا بالمعلومة ، بينما يجب ان يساعدنا بالتفاصيل ، حتى نساعده بالجواب 🙂 وخذها قاعده ، اذا لم يتم الرد على سؤالك خلال يومين ، ووجدت اكثر من 10 قراءات ، فيجب عليك اعادة عرض السؤال بطريقة مختلفه ، وبشرح افضل وبمثال 🙂 جعفر

@Elsayeh شكرا جزيلا على تفاعلك 😉 الرجاء اختيار افضل اجابة تراها ساعدتك في حل موضوعك حتى يتم قفل الموضوع من قبل ادرارة المنتدى . تحياتي .

بالتوفيق إن شاء الله تعالى

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

تفضل اخي طريقة عمل الجداول طريقة عمل جدول الاصناف.rar

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

السلام عليكم ورحمة الله وبركاته بعد إذن إخوتي الذين تقدموا بالحل - جزاكم الله خيراً على ماتبذلونه من جهود لمساعدة إخوانكم. أختي الكريمة أقترح عليكم تغيير تصميم الشيت ليكون أكثر فاعلية وديناميكية وذلك بعد اطلاعي على هذ الملف أولاً: الجدول ثانياً: التصفية التلقائية: والسلام عليكم السؤال 5.xlsm

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

الم تقراي توقيعي قبل اضافة متطلبات جديدة ؟😱 هل من العدل بعد الاجابة تقوم باضافات جديدة ومتطلبات جديدة لم تكن موجود في سؤالك . يجدر بك اختيار اجابتي واقفال الموضوع وعدم اهدار وقت الاعضاء في كل مرة يدور في بالك فكرة تريدين تطبيقها .🙄 لماذا نقول دائما يجب وضع متطلباتك في الملف .

ما شاء الله عمل رائع اشكر حضرتك جدا

اهلا اخي ابو خليل. علامة عادية مثلها مثل اي علامة - , _ اوغيرها استخدمها لعمل split وتقطيع النص في الـ VB.NET مثال:

وعليكم السلام ورحمة الله وبركاته أخي الكريم يمكنك التوصل إلى النتيجة بواسطة Pivot Table كما هو موضح في رابط الموضوع التالي: موضوع Pivot Table والنتيجة كما يلي: يمكنك الضغط على أي Total بجانب كل Department لتحصل على ورقة جديدة تظهر بها النتيجة مثل :اضغط على رقم 9953 نقرتين تحصل على جدول بقسم Baraha فقط في شيت جديد. والطريقة الثانية عبر التصفية التلقائية كما هو مبين أدناه: تقبل تحياتي العطرة والسلام عليكم. Time Attendance Details Report 15022022_125100.xls

انا اعمل على مثال الآن 🙂 وسأخبركم هنا بالموضوع الجديد ان شاء الله 🙂 جعفر

بصراحة هذا اخر محاولة وساخرج من هذا الموضوع تم اعطائه اكثر من حجمه Sub export_sheets() Dim Fname As String, ws As Worksheet Application.DisplayAlerts = False Sheets(Array("SH1", "SH3")).Copy For Each ws In ActiveWorkbook.Sheets ws.UsedRange = ws.UsedRange.Value Next ws ActiveWorkbook.SaveAs Filename:= _ "C:\Users\PC WORLD\Desktop\" & " report_ " & "W" & Format(Date, "WW") & "_" & Format(Date, "YYYY") & ".xlsx", FileFormat:=51 ActiveWorkbook.Close Application.DisplayAlerts = True End Sub

مالفائدة مما تطلبه ثم لم تدرج شكل البيانات كيف يجب ان تكون بعد تشغيل الكود المفترض.🙄

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

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

يوما ما ، انا احتجت الى مثل هذا التذكير ، وبعد البحث ، اتضح لي ان الاكسس ليس الاداة المناسبة لهذا العمل ، نعم يمكن تطويعه ، ولكن هناك ادوات افضل ، خليني اشرح الفرق : في الاكسس ، يجب عمل كود لتفقد ساعة الوندوز ، كل دقيقة مثلا ، ولكن هذا الكود واقعا يجعل الاكسس يعمل طوال الوقت في الخلفية ، فهو يتاكد من انتهاء الدقيقة ، وبعدها ينظر للكود لعمل المطلوب. وحتى لو عملت هذا البرنامج ، فسيكون في نسخته الاولى 🙂 بينما هناك برامج للوندوز ، تعمل بساعة الوندوز (حتى والاكسس مغلق) ، ولا تستهلك قوى اضافية من المعالج 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 قد يكون احتياجك يضطرك لإستخدام الاكسس ، فإن كان كذلك ، فأتمنى ان يهب الاعضاء ممن له الخبرة في هذا المجال للمساعدة 🙂 جعفر

الظاهر كان المفروض ان اعطي مثال على كلامي 🙂 ومثل ما قال اخي @ABOLO2 ، وهذا مثال آخر : . لا لا لا يا دكتور ، انت وقعت على مشكلة اسوأ ، وهي وجود الاوامر Dlookup و DSum في الاستعلام !! ارسل لي احد اصحابي برنامجه لأعالج بطئ الاستعلام ، واذا به الامر Dlookup ، ومجموع البيانات كانت حوالي 100,000 معلومة !! كنت اشغل الاستعلام ، واروح اعمل شاي ، ولما ارجع بعد 28 دقيقة ، كان عندي وقت كفاية آخذ شفطتين من الشاي ، وبعدين تظهر النتائج 😀 والحل كان ، بأن اعمل استعلام A يظهر البيانات بدل الامر Dlookup ، وفي الاستعلام الاخير B ، اربط معايير الاستعلام A بجداول الاستعلام B ، وتظهر النتائج في وقت جدا قصير 🙂 جعفر

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

السلام عليكم ورحمة الله وبركاته أخي الكريم في الخلية M9 اكتب المعادلة التالية ثم اسحب نزولاً =IFERROR(IF(I9="IN";K9;K9*(J9/30));"") تقبل تحياتي العطرة والسلام عليكم

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

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

جرب هذا الماكرو 1- الماكرو يظهر معاينة قبل الطباعة من اجل الطياعة مباشرة استيدل السطر Sh.PrintPreview بالسطر Sh.PrintOut Option Explicit Sub Print_all() Dim Sh As Worksheet Dim k% Application.EnableEvents = False Set Sh = Sheets("الربع") Sh.PageSetup.PrintArea = "$B$2:$L$21" For k = 26 To 81 If Sh.Range("C" & k) <> "" Then Sh.Range("D5") = Sh.Range("C" & k) Sh.PrintPreview 'Sh.PrintOut End If Next k Sh.PageSetup.PrintArea = "" Application.EnableEvents = True End Sub الملف مرفق Alaa.xlsm