أ / محمد صالح

كتعديل في كود الفلتر وعدم الحاجة لكود إلغاء الفلتر يمكن استعمال هذا الكود في حدث تغيير محتوى الخلايا في الشيت Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$8" Then Dim LastRow As Long Dim FilterRange As Range LastRow = Me.Cells(Rows.Count, "D").End(xlUp).Row Set FilterRange = Range("C9:U" & LastRow) If Not IsEmpty(Range("D8")) Then FilterRange.AutoFilter Field:=2, Criteria1:=Range("D8").Value Else FilterRange.AutoFilter Field:=2 End If End If End Sub بالتوفيق

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

أخي الكريم @عماني عماني كنت قد شرجت قبل ذلك هذا الأمر في منتدانا الكبير أوفيسنا وأبسط الحلول بالمعادلات وليس بالكود * أن تمسح بيانات العمود A والعمود J * وتضبط خيارات الإكسل إلى تفعيل خاصية الحساب التكراري iterative calculation File - options - formula * تستعمل هذه المعادلة في C4 ويتم نسخها إلى D4 & E4 وكذلك إلى L4 & M4 & N4 مع تغيير A4 إلى J4 =IF($A4="","",IF(C4<>"",C4,NOW())) * تغيير تنسيق الخلية في اليوم إلى dddd وفي الوقت إلى hh:mm:ss بالتوفيق

هذه محاولة مني ضع هذه المعادلة في L5 =IFERROR(INDEX($I$5:$I$272,MATCH(0,IFERROR(MATCH($I$5:$I$272,$D$5:$D$1370,0),COUNTIF($L$4:$L4,$I$5:$I$272)),0)),"") واتسخ لأسفل 100 صف فقط حتى لا تبطئ الملف وإذا كان الأوفيس قديم نسبيا يجب الضغط على كنترول وشيفت وانتر بالتوفيق

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

لن تجد ما يناسبك مائة بالمائة إلا أن تصمم برنامجك بنفسك وتعرض مشكلتك إذا صادفتك مشكلة وهذه عينة من برامج الفواتير https://www.officena.net/ib/search/?&q=برنامج فواتير&type=forums_topic&quick=1&nodes=135&search_and_or=and&sortby=relevancy بالتوفيق

ممكن تستعمل for ..... next لكن في كل مرة ستفتح نافذة جديدة في المتصفح

ربما تفيدك هذه الموضوعات https://www.officena.net/ib/search/?q=تفقيط الدينار الكويتي &updated_after=any&sortby=relevancy&search_and_or=and بالتوفيق

جرب هذا الكود المختصر بإذن الله يكون هو المطلوب Private Sub CommandButton1_Click() Dim contact As String, mytext As String contact = TextBox1.Value mytext = TextBox2.Value ' Google Messages ActiveWorkbook.FollowHyperlink Address:="https://messages.google.com/web/conversations/new" Application.Wait (Now + TimeValue("00:00:10")) Call SendKeys(contact, True) Application.Wait (Now + TimeValue("00:00:04")) Call SendKeys("{TAB}", True) Application.Wait (Now + TimeValue("00:00:01")) Call SendKeys("~", True) ' Enter key Application.Wait (Now + TimeValue("00:00:04")) Call SendKeys(mytext, True) Application.Wait (Now + TimeValue("00:00:01")) Call SendKeys("~", True) ' Enter key Application.Wait (Now + TimeValue("00:00:04")) MsgBox "Done by mr-mas.com" End Sub بالتوفيق

إذا كان مقصودك اختيار المجلد الفرعي من العشرة لمرة واحدة فلماذا لا يتم تمرير اسم المجلد الفرعي للكود ؟؟ مثلا المجلد الفرعي رقم 1 يتم نسخ جميع الملفات في المجلد الفرعي رقم 1 داخل المجلد الذي يوافق اسم الملف. وفي هذه الحالة ما فائدة المجلدات الفرعية التسعة الأخرى؟؟؟!!! على العموم ضع متغيرا جديدا للمجلد الفرعي في آخر الإعلان عن المتغيرات Dim extension As String Dim subfolder as String واستبدل هذه السطور قبل النسخ If fileName = folderName Then FileCopy sourcePath & fileItem, targetPath & folderItem & "\" & fileItem End If إلى هذه والتي تعرض مستعرض المجلدات لمرة واحدة في أول ملف ابتداء من أول مجلد ثم يتم النسخ في المجلد الفرعي بنفس الاسم في جميع المجلدات المطابقة لاسماء الملفات If fileName = folderName Then If subfolder = "" then With Application.FileDialog(msoFileDialogFolderPicker) .Title = "اختيار المجلد الفرعي" .InitialFileName = targetPath & folderItem & "\" If .Show = -1 Then subfolder = .SelectedItems(1) & "\" Else MsgBox "لم يتم اختيار المجلد الفرعي" Exit Sub End If End With End If FileCopy sourcePath & fileItem, subfolder & fileItem End If بالتوفيق

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

يمكنك استعمال هذه المعادلة لاقتصاص الأرقام من الثاني بطول 11 رقما =MID(A2,2,11) بالتوفيق

الكود يقوم بنسخ الملفات إلى مجلدات بنفس الاسم فمثلا ملف اسمه 17.pdf يتم نسخه في مجلد 17pdf على أي أساس تريد وضعه في أحد المجلدات العشرة؟ داخل المجلد 17pdf ؟؟؟

حسب فهمي للمطلوب يمكنك استعمال هذه المعادلة في الخلية V3 مع الاعتماد على خلايا الاعمود AD & AF حتى يمكن تغيير النسب بدون تغيير المعادلة =IF(V1<AD1,AF1,IF(V1<AD3,AF2,AF3))*V1-V2 بالتوفيق

لا يوجد مشكلة بالملف تم تثبيت الصفوف من 1 إلى 8 من نافذة إعداد الصفحة في تبويب pagelayout بالتوفيق التمـــام الشهــري.xlsx

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

يوجد اختلاف بين العنوان ومضمون الموضوع فإذا كنت تريده عند إغلاق ورقة العمل يمكنك وضع الكود بدون أول وآخر سطر في حدث إلغاء تفعيل الشيت Private Sub Worksheet_Deactivate() End Sub ةإذا كان المفصود عند إغلاق الملق كله فيمكنك وضعه في حدث قبل إغلاق مصنف العمل thisworkbook Private Sub Workbook_BeforeClose(Cancel As Boolean) End Sub بالتوفيق

حسب فهمي للمطلوب جرب استعال هذه المعادلة =SUBTOTAL(103,A2:A1000) لعد الخلايا الظاهرة في العمود A بالتوفيق

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

أخي الكريم لماذا كل هذا التردد والحيرة؟؟؟؟!!!!!! عرضت قبل ذلك مشكلتك هـــــــــتا وحذرتك من اختلاف طريقة التعامل مع الأرقام فبعض الأرقام تضرب في 1000 وبعض الأرقام توضع كما هي وباستجوابك توصلنا إلى أنه إذا كانت الأرقام موجبة تضرب في 1000 وإذا كانت الأرقام سالبة توضع كما هي واليوم تضع اختلافا جديدا حيث تريد أن بعض الأرقام الموجبة تضرب في 1000 وبعضها لا تضرب!!!!!! فعلي أي أساس؟؟؟ وللمرة المليون يجب توحيد طريقة التعامل مع المدخلات فإذا كنت تضرب في 1000 فيجب كتابة ال 1000 بصورة 1 وفي هذه الحالة يكوزن المجموع 1+2 = 3 في 1000 = 3000 وكذلك في حالة الأرقام السالبة تريد إنقاص 500 تكتب - 0.5 عند الضرب في 1000 = -500 بهذه الطريقة ستقلل طول المعادلة وتقلل نسبة الخطأ بالتوفيق

يمكنك إضافة شكل شفاف بدون إطار وعند تحديده تكتب في شريط المعادلة =J5 ليعرض النص المختار من القائمة ويمكن تحريك هذا الشكل إذا تغير حجم الصورة بالتوفيق

ما دامت ورقة العمل محمية فلا يمكن دمج الخلايا إلا باستعمال كود VBA وأن يبدأ الكود بسطر لفك الحماية ثم أي كود تريده كدمج نطاق معين أو دمج الخلايا المحددة ثم آخر سطر لإعادة حماية الشيت مرة أخرى ActiveSheet.Unprotect "password" Range("C3:E3").Merge 'Selection.Merge ActiveSheet.Protect "password" وأنصح ألا يحتاج المستخدم لدمج خلايا جديدة بعد حماية ورقة العمل فالأولى دمج الخلايا قبل الحماية بالتوفيق

خطوة جميلة بالتوفيق

ما شاء الله إبداع وفقك الله أخي الفاضل ابو أحمد

أخي الكريم @كمال علام صاحب هذا البرنامج البسيط قام بحماية الأكواد بكلمة مرور وتقريبا يتم وضع المعادلات بالكود لذلك إذا كنت تعرفه اسأله عن كلمة مرور vba لعمل التعديل المطلوب بالتوفيق