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

إذا كان مقصودك اختيار المجلد الفرعي من العشرة لمرة واحدة فلماذا لا يتم تمرير اسم المجلد الفرعي للكود ؟؟ مثلا المجلد الفرعي رقم 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 بالتوفيق

السلام عليكم تم الترتيب في J3 القائمة المنسدلة سوء كان أبجدي أو رقمي كما ذكرت سابقاً وتم تحديد مدى الفرز والتصفية ب 3352 صف ويمكن التغير حسب الطلب والحاجة وشكراً لكل من شارك وساعد الخزينة3 معدل.xlsb

السلام عليكم ورحمة الله وبركاته.. بعد الإستفادة من مجموعة كبيرة من مواضيع المنتدى والإخوة الأعضاء جميعاً بدون الحصر ، أرجو ممن يهتم بإبداء رأيه حول مشروعي الأول ببرنامج محاسبي ( اتمنى ان يكون متكامل من حيث المحتوى والخدمة المقدمة ) .... رابط التحميل على ميديافاير إن لم يتعارض مع سياسة الموقع https://www.mediafire.com/file/0tti9if8w3p1zbz/Wisso_2023.zip/file البرنامج تم إنشاءه على أوفيس 2016 ارتأيت أن أضع المقال بموضوع منفصل حتى يتسنى لي الإستفادة من خبرة الكثيرين بنقاط الضعف ، أو إن غاب عني شيء أثناء التصميم.

@2saad هل ممكن ان تقول لي المتغير i فيما يستخدم بناء على كودك؟!!! Private Sub CommandButton2_Click() Dim add As Integer i = Application.WorksheetFunction.CountA(Sheet54.Range("c:c")) add = Sheet54.Range("c1000").End(xlUp).row + 1 Sheet54.Cells(add, 3).Value = Me.TextBox1.Value Sheet54.Cells(add, 4).Value = Me.TextBox2.Value Sheet54.Cells(add, 5).Value = Me.TextBox3.Value Sheet54.Cells(add, 6).Value = Me.TextBox4.Value Sheet54.Cells(add, 7).Value = Me.TextBox5.Value Sheet54.Cells(add, 8).Value = Me.TextBox6.Value Sheet54.Cells(add, 9).Value = Me.TextBox7.Value Sheet54.Cells(add, 10).Value = Me.TextBox8.Value Sheet54.Cells(add, 11).Value = Me.TextBox9.Value Sheet54.Cells(add, 12).Value = Me.TextBox10.Value Me.TextBox1.Value = "" Me.TextBox2.Value = "" Me.TextBox3.Value = "" Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" Me.TextBox9.Value = "" Me.TextBox10.Value = "" MsgBox "تم حفظ البيانات بنجاح يا عم سعد", vbInformation, "تنبيه يا عم سعد" End Sub جرب هذا التغيير ولكن قبل كل شيء اتبع الخطوات بعناية 1- احدف اي صف فارغ في الجدول ( لا تجعل الجدول يحتوي على صفوف فارغة) 2- لا داعي للتيكست بوكس الخاص بالتسلسل لانه الكود سيقوم بادراج صف ويقوم بترقيمها اتوماتيكيا حينها سيصبح عند 9 تيكست بوكس وليس 10 كما في الكود 3- تم التعديل باضافة اجراءات خاصة بكائن الجدول هذه محاولة قد تفيدك Private Sub CommandButton2_Click() Dim tbl As ListObject Dim LastRow As Long Set tbl = Sheet54.ListObjects("Table14") LastRow = tbl.Range.Rows.Count With Sheet54 tbl.Range(LastRow, "B").Offset(1) = TextBox1.Value tbl.Range(LastRow, "C").Offset(1) = TextBox2.Value tbl.Range(LastRow, "D").Offset(1) = TextBox3.Value tbl.Range(LastRow, "E").Offset(1) = TextBox4.Value tbl.Range(LastRow, "F").Offset(1) = TextBox5.Value tbl.Range(LastRow, "G").Offset(1) = TextBox6.Value tbl.Range(LastRow, "H").Offset(1) = TextBox7.Value tbl.Range(LastRow, "I").Offset(1) = TextBox8.Value tbl.Range(LastRow, "J").Offset(1) = TextBox9.Value End With MsgBox "تم حفظ البيانات بنجاح يا عم سعد", vbInformation, "تنبيه يا عم سعد" Me.TextBox1.Value = "" Me.TextBox2.Value = "" Me.TextBox3.Value = "" Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" Me.TextBox9.Value = "" End Sub

مشاركة مع استاذنا @ابوخليل الحاق او اضافة البيانات بدون استعلام عن طريق مصدر السجلات Dim rs As Recordset Dim rst As Recordset Dim db As Database Dim a As Integer Dim fld As DAO.Field Set rs = CurrentDb.OpenRecordset("adafh_tl8a2yh") Set rst = CurrentDb.OpenRecordset("tbltexts") rs.MoveFirst For a = 0 To rs.RecordCount - 1 If rs!adafh_tl8a2yh = True Then rst.AddNew For Each fld In rs.Fields rst.Fields(fld.Name) = fld.Value rst!kod_alad5al_tblTexts = Me.كود_العميل Next fld rst.Update End If rs.MoveNext Next a rs.Close: rst.Close Set rs = Nothing: Set rst = Nothing Me.نموذج_فرعي_الفواتير.Requery الملف مرفق اخونا شايب إضافة اصناف.accdb

جرب هذا الكود المختصر بإذن الله يكون هو المطلوب 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 بالتوفيق

وعليكم السلام ورحمة الله وبركاته 🙂 هل هذا ما تريده ؟ طبعا للحصول على هذه البيانات .. أنسخ الموديول المرفق كاملا كما هو .. وهو يحتوي على العديد من الدوال الخاصة بالتعامل مع الملفات من جميع النواحي ( نسخ - لصق- نقل - حذف - ودوال للحصول على بيانات الملفات كما هو واضح لديك .. 🙂 ) ثم في مربعات النص التي في النموذج أنظر لطريقة إحضار بيانات الملفات .. باستخدام الدوال المرفقة في الموديول .. وكذلك في كل دالة مكتوب فيها بالتفصيل كيفية استخدامها 🙂 TknDate.accdb

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

السلام عليكم تفضل حل اخر حساب متوسط.xlsx

السلام عليكم ورحمة الله وبركاته ،، تم تحديث الروابط على ميجا كالتالي :- نسخة 32 بت نسخة 64 بت تفضل في المشاركة السابقة ، تم تحديث الروابط على موقع ميجا 🙂 تفضل في المشاركة السابقة ، تم تحديث الروابط على موقع ميجا 🙂

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

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

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

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

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

إذا أردت أن تبحث عن كلمة أو جملة لونها غير أسود، أو غير تلقائي، فهذا الماكرو سيفيدك إن شاء الله: ' ' البحث عن نص غير تلقائي (أسود) ' ' Dim OutPut As Integer With Selection.Find .Text = InputBox(prompt:=" : أدخل كلمة (جملة) البحث ", _ Title:="البحث عن الكلمات أو الجمل غير السوداء") Do While .Execute With Selection.Font If (.Color <> wdColorAutomatic) And _ (.Color <> wdColorBlack) Then If MsgBox("البحث عن التالي", vbQuestion + vbYesNo) <> vbYes Then Exit Sub End If End If End With Loop End With End Sub

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

بارك الله فيكم جميعا جميل جدا هذا العمل إبداع وهذه مساهمتي للبحث في موضوعات منتدى الاكسس ولكن في مجال الويب حتى يمكن البحث بسرعة بمجرد الكتابة ولو في الموبايل بدون الحاجة إلى برنامج الأوفيس https://officena.net/team/mas/access.html بالتوفيق للجميع دعواتكم

أخي عمر جرب تنزيل هذا التطبيق في هاتفك الأندرويد .. يقوم بنفس العمل 🙂 https://play.google.com/store/apps/details?id=com.poe.android&pli=1

جرب المرفق بعد اذنك اخي محمد البرناوي <><><><><><><><><> ForTest.accdb

• البحث عن كلمة أولها (ال) وآخرها (تنوين): <ال[! ]@[ًٌٍ]> • كلمة أولها (ال) وآخرها (ون) ليس بعدها (فتحة): ال[! ]@(ون)[!َ]> • البحث عن أي كلمة أو رمز، أو رقم: <[! ]*> • البحث عن أي كلمة، وهي تصلح في عمل الماكرو: <[أ-ىيئءؤآءاإًٌٍَُِّْ]@> • أو: <[أ-يَّآًٌٍُِْ]@> • البحث عن أي كلمة: <[أ-ي]@> أو: <?@?> • البحث عن أي كلمة: <[! ]@> يكتب قبلها كلمة عند البحث والاستبدال لأنها تبطئ الماكرو، وربما تهنج الورد. • البحث عن أي كلمتين: <[! ]@> <[! ]@> • البحث عن أي كلمتين الأولى تبدأ بهمزة، والثانية تنتهي بتاء مربوطة: <أ[! ]@> <[! ]@ة> • البحث عن أي كلمتين الأولى آخرها ألف، والثانية تنتهي بالألف: <[! ]@ا> <[! ]@ا> • البحث عن كلمتين متتاليتين مكررتين: (<* ){2} ، ويمكن البحث بـ{3، 4} أو <([أؤئإءيا-ى]@)> \1> أو: (<[ء-يا-ى]@)[ ,.;:]@\1> • البحث عن كلمتين، أو عددين، أو جملتين متتاليتين مكررتين: (<*>) \1 • البحث عن كلمتين، أو عددين، أو جملتين متتاليتين مكررتين بينهما فاصلة: (<*>)، \1 • ولحذف الكلمة أو الجملة المكررة نضع في مربع الاستبدال: \1 • البحث عن حرفين أو رقمين متتاليين متطابقين: (?){2} • البحث عن أي كلمتين أو حرفين أو رقمين متتاليين متطابقين: (<*){2} • البحث عن أي كلمتين متطابقتين بينهما أي كلمة: (<[! ]@>) [! ]@ \1 • البحث عن آخر كلمة في الخلية (تنفع للشعر): <[أ-ىيئءؤءاإًٌٍَُِّْ]@>[! ء-ى] • البحث عن آخر كلمة مشكولة في الخلية (تنفع للشعر): <[ء-ي]@[! ء-ي]> • البحث عن آخر كلمة مشكولة في الخلية آخرها (ا-و-ى-ي) (للشِّعر): <[ء-ي]@[! ء-ي][اوىي]> • البحث عن آخر كلمة مشكولة في الخلية بعدها مسافة (للشِّعر): <[ء-ي]@[! ء-ي]> • البحث عن آخر كلمة ليس بها أي تشكيل في الخلية (للشِّعر): <[ء-ي]@[! ًٌٍَُِّْ]>[! ء-يٰ] • أو: <[ء-ي]@>[!? ٰ] • البحث عن أي كلمة في الخلية عدا الكلمة الأخيرة: <[أ-ىيئءؤآءاإًٌٍَُِّْ]@>[!^13] • البحث عن أي كلمة في الخلية عدا الكلمة الأولى: [!^13]<[أ-ىيئءؤآءاإًٌٍَُِّْ]@> • البحث عن كلمة في الخلية عدا الأولى والأخيرة: [!^13]<[أ-ىيئءؤآءاإًٌٍَُِّْ]@>[!^13] • البحث عن أي رقمين متتاليين بينهما فاصلة مثل 22، 22، ويمكن بـ{3، 4}: (<*){2}، (<*){2} • البحث عن أي رقمين متتاليين بينهما فاصلة، وليس قبلهما سلاش: [!\/]<[0-9]@>، <[0-9]@>[!\/] • البحث عن أي رقمين متتاليين بينهما فاصلة، الثاني ليس قبله سلاش: <[0-9]@>، <[0-9]@>[!\/] • البحث عن فقرة وتظليلها: (*^13) • البحث عن فقرتين متتاليتين متطابقتين: (*^13)\1 • البحث عن ثلاث فقرات متتالية متطابقة: (*^13)\1\1 • البحث عن فقرة قبلها فقرة فارغة وبعدها فقرة فارغة: ^13{2}([!^13]@^13)^13 • البحث عن فقرة قبلها فقرة فارغة: ^13{2}([!^13]@^13) • البحث عن فقرة قبلها أو بعدها فقرة فارغة: ^13{2}([!^13]@) • ولحذف هاتين الفقرتين الفارغتين ضع في خانة الاستبدال: ^p<H1>\1 • البحث عن الفقرات المكررة بشكل متتالي: (*^13)(\1)@ • البحث عن فقرة عن طريق حروف البدل: ^13 • البحث عن فقرة قبلها أي حرف عن طريق حروف البدل: >^13 ، وبعدم اعتبار المسافة آخر الفقرة: >^13* • البحث عن أي فقرة إلى كلمة (في) مثلا للتظليل: <[! ]*في> • البحث عن فقرة ليس في نهايتها (.) أو (:) أو (؟) أو (!): ([!^13.:\؟\!\-\!]^13) • تحديد ما بين الفاصلتين: ، <[! ]*>، • تحديد ما بين أي كلمتين متطابقتين: (<[! ]@>) [! ]* \1 • تحديد أي كلمتين متطابقتين بعد كل منهما أي كلمة: (<[! ]@>) [! ]@ \1 (<[! ]@>) • تحديد ما بين كلمتين مثل: عن <[! ]*> عن • البحث عن أي كلمة مكونة من حرفين: <[! ]@{2}> • البحث عن أي كلمة مكونة من حرفين آخرها تنوين: <[! ]@{2}[!ًٌٍ]> • البحث عن كلمة خمس حروف ليس منها علامات الضبط: <[! ]@{5}[ًٌٍَُِّْ]> • للبحث عما بين قوسين هلاليين: (\(*)\) أو \(?@\) • للبحث عما بين قوسين هلاليين باستثناء علامة الحاشية: \(<[أ-ىيئءؤءاإًٌٍَُِّْ]*>\) • للبحث عما بين معقوفين: \[?@\] • للبحث عن أي رقم دون الحروف: [0???-9] • للبحث عن أي رقم فردي أو زوجي أو أكثر: <[0-9]@> • لتظليل رقم بعده سلاش (شرطة مائلة/) حتى آخر الفقرة: <[0-9]@>/*^13 • لوضع كل رقم بعده سلاش في فقرة: في خانة البحث: <[0-9]@>/ وفي الاستبدال: ^13^& • للبحث عن رقم واحد: <[0-9]{1}> أو رقمين: <[0-9]{2}> وهكذا بزيادة رقم بين {} • للبحث عن أي كلمة دون الأرقام: <[أ-ى][! ]@> • للبحث عن أي رقمين بينهما فاصلة: [0???-9]، [0???-9] • للبحث عن الأرقام بين سلاشين شرطتين مائلتين //: /[???0-9]*/ • للبحث عن أي رقم حتى نهاية الفقرة: [0-9]*^13 • للبحث عن الحروف والأرقام دون المسافات وعلامات الترقيم: [أ-ي0-9] • البحث عن الحاشية السفلية مع حروف البدل: ^2 • البحث عن الحاشية الفارغة التي بعد رقمها قوس هلالي: ^2\) [!ء-ي] • البحث عن الحاشية الفارغة التي ليست بين قوسين: ^2[!\)][!ء-ي] • البحث عن حاشية قبل علامة الترقيم: ([.:،؛\?\!])\(^2\) • البحث عن قوس مربع [ ليس له قوس غلق ] : \[[!\]]@^13 • البحث عن قوس هلالي ( ليس له قوس غلق ) : \([!\)]@^13 • البحث عن قوس مدبب ( ليس له قوس غلق ) : \«[!\»]@^13 • البحث عن قوس مرعوش ( ليس له قوس غلق ) : \{[!\}]@^13 • لعكس ترتيب كلمات متتالية مثل: عماد محمد أحمد، نضع في خانة البحث: (عماد) (محمد) (أحمد) : وفي خانة الاستبدال: \3 \2 \1 مع مراعاة أن تكون الأرقام باللغة الإنجليزية. • لنقل كلمة مكان سابقتها والعكس، مثل: محمد عمر ، نضع في خانة البحث: (محمد) (عمر) : وفي خانة الاستبدال: \2 \1 • لنقل علامة الحاشية قبل علامة الترقيم: في خانة البحث: ([.،:;\?\!])(\(^2\)) : وفي خانة الاستبدال: \2\1 • للبحث عن أكثر من مسافة متتالية: [ ]@([! ]) • ولجعلها مسافة واحدة نستبدلها بـ: \1 • لجعل علامة الحاشية بين قوسين: في مربع بحث اكتب الآتي ^f وفي مربع استبدال اكتب (^&) وهذا الكود يعني أن المكتوب في خانة البحث يساوي المكتوب في خانة الاستبدال، فيمكن استخدامه مع أي حرف وأي رقم، حيث الاستبدال لا ينفع مع أي حرف وأي رقم، لكن بإضافة هذا الكود يصبح الاستبدال متاحا. • لإضافة صفر بعد رقمين مثل (015): نضع في خانة البحث: <[0-9]{2}> وفي الاستبدال: 0^& • لإضافة صفر بعد رقم واحد، مثل (05): في خانة البحث: <[0-9]{1}> وفي الاستبدال: 0^& • للبحث عن أي رقم بعده صفر (0) بعده سلاش (/) على صورة (08/): 0^#/

اولا شكرا لك استاذنا @أبو آدم قم بفتح القاعدة بيانات وافتح احد نماذج في وضع تصميم واضغط على كونترول و حرف جي الانكليزية ctrl + G سيفتح لك هذه النافذة في الاسفل نافذة كتابة الاكواد كما مبينة في الصورة قم بكتابة هذه الجملة واضغط على انتر لكي يتم تفعيل خصائص الورقة CommandBars("Property Sheet").Enabled = True واذا تريد عدم التفعيل اكتب هذا CommandBars("Property Sheet").Enabled = false واضغط على انتر تقبلوا تحياتي

السلام عليكم بعد إذن الاستاذ سليم تعديل بسيط حسب ما يحب أبو البراء Sort_by_text_len advanced Macro2.rar

السلام عليكم ورحمة الله وبركاته كل عام وانتم بخير بمناسبة عيدالاضحى اقدم اليكم حالة عملية لدالة VLOOKUP فى تحديد سعر صنف ضمن مجموعة اسعار لهذا الصنف . وقد استخدمت دالة VLOOKUP لسهولتها . بعيدا عن الدوال الاخرى التى من الممكن ان تستخدم وسائط اكثر مثل INDEX ارجو ان تكون ذات فائده للجميع تقبلوا خالص تحياتى استخدام الداله VLOOKUP فى تحديد السياسات السعريه.rar

السلام عليكم وهذه معادلة اخرى بعد معادلة استاذى بن علية حاجى جزاه الله خيرا =SUMPRODUCT(SUBTOTAL(3;OFFSET($B$4:$B$20;ROW($B$4:$B$20)-MIN(ROW($B$4:$B$20));;1))*(1/COUNTIF(B4:B20;B4:B20))) هل ممكن هذه المعادلة تعد بدون تكرار.rar

السلام عليكم ورحمة الله أخي الكريم، لا أعتقد أنه يمكن باستعمال الدالة SUBTOTAL عمل ذلك (بتحفظ)... وأقترح عليك المعادلة التالية التي تقوم بعدّ القيم الفريدة (المختلفة ودون تكرار): =SUMPRODUCT(1/COUNTIF(B4:B20;B4:B20)) بن علية

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

اخى الريفى موضوع جميل ومهم جدا اشكرك على المعلومات الجميله دى اسمح لى بان تضيف هتين المعادلتين عندك =IF(COUNTIF($B$5:$B5,$B5)=1,$B5,"") =INDEX(B:$B,MIN(IF(COUNTIF($D$4:D4,$B$5:$B$17),2^15,ROW($B$5:$B$17)))) هذه المعادلات معادلات صفيف تقبل تحياتى