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

وفيك بارك الله اخى @nabilalibibo وانا اتعلم منكم ومعكم وطبعا انا قصدت الاشاره لموضوعك السابق ووضعت نفس الصيغه السابقه لمعلمنا العزيز جعفر جزاه الله عنا كل خير حتى ترى الفرق وتبحث وتتعلم ولتعلم ان الداله left , right , mid من دوال القطع فلتبحث عنهم بالموقع او بجوجل ستجد الكثير من الشرح لهم جزاك الله خيرا مهندسنا العزيز @Eng.Qassim ع مشاركتك معنا 💐 انت اعتمدت على الداله mid فماذا لو كان هناك رتبه تزيد عن 11 رقم المقطوع وليست ضمن القيم التى نريد الحصول عليها من فضلك القى نظره على الاستعلام Q1 و Q2 فى الاستعلام Q2 قمت باستخدام حل آخر لمراعاه الشرط (كيف اجعل كل موظف تبدأ ) Like "ممارس متخصص*" وليس لان هذا سياتى بكل ما هوى محتوى ع ممارس متخصص Like "*ممارس متخصص*" او نجعلها هكذا تمنياتى لكم وللجميع بالتوفيق Database1011_2.accdb

مشاركة مع اساتذتي الكرام Database1011.accdb

تفضل تــم عمل المطلوب -فهذا الكود لزر الخروج من ملف الإكسيل بعد الحفظ Private Sub خروج_Click() ThisWorkbook.Saved = True Application.Quit End Sub كما تم عمل زر بكل صفحة للعودة للصفحة الرئيسية Main كل ما عليك هو الضغط على أيقونة Go To Sheets سيظهر لك مربع حوارى عليك بكتابة اسم الصفحة المراد الوصول لها من خلال الضغط على OK اكواد.xlsm

تم التعديل أخي أبو عبدالرحمن كما طلبت .. وأبقيت على الكود السابق لكي يعمل تلقائيا عند إضافة سجل جديد .. أولا قمت بتغيير أسماء جميع العناصر والحقول إلى اللغة الإنجليزية لكي يسهل التعامل مع الأكواد 🙂 ثم أضفت هذا الكود على زر إعادة الترقيم : Private Sub ReNumbringBtn_Click() Dim DB As dao.Database Dim RS As dao.Recordset Set DB = CurrentDb Set RS = DB.OpenRecordset("Table1") ' تصفير الأرقام للبدأ من جديد DoCmd.SetWarnings False DoCmd.RunSQL ("update table1 set t1 = 0") DoCmd.SetWarnings True ' إعادة الترقيم With RS .MoveFirst Do Until .EOF .Edit !t1 = Nz(DMax("t1", "Table1", "[SchoolName]='" & !SchoolName & "'") + 1, 1) .Update .MoveNext Loop End With Set DB = Nothing Set RS = Nothing DoCmd.OpenTable "table1" MsgBox "تم ترقيم المدارس بنجاح", vbOKOnly, "انتهى" End Sub والآن يمكنك تجربته ولا تنسى تغيير المسميات التي في الكود لتوافق المسميات الموجودة لديك 🙂 المرفق : Numbring.accdb

في هذه الحالة هذي تُعمل في فورم وليس في الجدول مباشرة .. تضع هذا الكود في حدث بعد التحديث لاسم المدرسة : Private Sub اسم_المدرسة_AfterUpdate() Dim N As Integer N = Nz(DMax("t1", "جدول1", "[اسم المدرسة]='" & Me.اسم_المدرسة & "'") + 1, 1) Me.t1 = N End Sub بشرط كتابة اسم المدرسة بشكل صحيح لكي يتعرف عليه الكود . وعند إضافة سجل جديد سيعطيك الرقم التالي لأكبر رقم مسجل في الجدول لنفس المدرسة 🙂 New Microsoft Access Database.accdb

That's great you have tried that's a great step towards learning Sub Test() Dim m As Long, r As Long, n As Long Application.ScreenUpdating = False With ActiveSheet m = .Cells(Rows.Count, 1).End(xlUp).Row n = 1 .Columns("K:M").WrapText = True For r = 1 To m Step 3 .Range("K" & n).Resize(, 3).Value = Array(.Range("A" & r).Value & vbLf & .Range("A" & r + 1).Value & vbLf & .Range("A" & r + 2).Value, .Range("B" & r).Value & vbLf & .Range("B" & r + 1).Value & vbLf & .Range("B" & r + 2).Value, .Range("C" & r).Value & vbLf & .Range("C" & r + 1).Value & vbLf & .Range("C" & r + 2).Value) n = n + 1 Next r End With Application.ScreenUpdating = True End Sub

نسخة محدثة ، والله من وراء القصد Building_3.rar

يا استاذ @عبدالقدوس48 اولا جزاكم الله خيرا واسمح لى بإضافة مرفق آخر زيادة فى الخير طريقة حضرتك يتم فيها غلق قاعدة البيانات حتى لو يتم التعامل داخل قاعدة البيانات انظر الى الطريقة الاتية فى تلك القاعدة المرفقة فى النموذج الذى يحمل اسم Form1 كود فى حدث الوقت يتم تصفير العداد عند التنقل والعمل على قاعدة البيانات وفى حالة ترك القاعدة دون العمل عليها يتم اغلاق القاعدة idle time.rar

وعليكم السلام ورحمه الله وبركاته اتفضل اخى @nabilalibibo ان شاء الله يكون ما تريد وتقريبا كان ليك موضوع مشابه لهذا ورد عليك معلمنا العزيز جعفر جزاه الله عنا كل خير بالتوفيق Database1011_1.accdb

السلام عليكم اهل المنتدى الكرام أقدم اليكم برنامج : لجميع الانشطة ( تجارى – صناعى – خدمى – مقاولات ) مطابق تمام لمعايير المحاسبة الدولية كافة المعاملات ( حسابات ختامية – مراقبة مخازن – عملاء – موردين – شئون عاملين – استيراد – تصدير – مستخلصات – مراكز تكلفة – خطوط انتاج – مقايسات - باركود) يشمل البرنامج :- - حسابات الاستاذ كاملة وموازين المراجعة والارباح والخسائر والمركز المالى - تكاليف العمليات وتحليل تكاليف المشروعات وبنود الاعمال بشكل تفصيلى واجمالى - مستخلصات المشروعات - الايرادات - ومستخلصات مقاولين الباطن - منظومة الاجور والمرتبات بشكل متكامل ويمكن تعديلها حسب قانون الدولة - حسابات ضريبة المبيعات والارباح التجارية والصناعية وضريبة كسب العمل وطباعة الاقرارات الضريبية - مراقبة المخازن ومتابعة كروت الصنف وتسعير المنصرف بثلاثة طرق ( الوارد اولا يصرف اولا – المتوسط المرجح – اخر سعر ) - امكانية قرائة وطباعة الباركود وبدون الحاجة لطابعة خاصة - حسابات النقدية بالصندوق والبنوك وتعدد العملات - تكاليف الاستيراد وحساب تكلفة المشتريات المستوردة - حسابات تكاليف خطوط الانتاج وحساب تكلفة الوحدة من المنتجات - تعدد المستخدمين للبرنامج وصلاحيات خاصة لكل مستخدم وسهولة اضافة وحذف مستخدم وسهولة تعديل الصلاحيات - امكانية اضافة مجموعة شركات داخل البرنامج وكلمة مرور لكل شركة - يصلح البرنامج للعمل فى مصر وفى دول الخليج العربي - البرنامج يشمل روابط شرح تفصيلى لكل اجزائه واسم المستخدم وكلمة السر admin 123 وهذا هو البرنامج: بارك الله فيكم The_fastest.rar

اعرض الملف برنامج ::🎁 📚(( مكتبة الأكواد الخاصة ))📚🎁 :: بسم الله الرحمن الرحيم أضع بين أيديكم برنامج :: (( مكتبة الأكواد الخاصة )) :: وهو عبارة عن حافظة شخصية للأكواد والملفات الخاصة بمبرمج الأكسس أو أي مبرمج آخر .. البرنامج به كم لا بأس به من الأكواد التي كنت أستخدمها في تصميم البرامج، بعضها من إبداعات الإخوة في الموقع وبعضها من مصادر أخرى.. من مميزات البرنامج خاصية البحث السريع للوصول للأكواد بسهولة .. وفيه تقسيمات للأكواد المجربة وغير المجربة .. وكذلك يمكن الإشارة للمرجع الذي تم أخذ الأكواد منه .. وأيضا يمكن حفظ الملفات المرتبطة والأمثلة في مجلدات قرينة بالبرنامج 🙂 البرنامج مفتوح المصدر ويمكن لك أن تغير فيه ما تشاء ليلبي احتياجاتك الشخصية .. 🌷 :: تحياتي :: 🌷 🙂 :: ولا تنسوني من صالح دعواتكم :: 🙂 صاحب الملف Moosak تمت الاضافه 15 مار, 2022 الاقسام قسم الأكسيس  

السلام عليكم ورحمة الله وبركاته بناء على طلب احد الاحباب هذا العمل للتجربة اولا برجاء فتح القاعدة وموافتى بالاتى هل تم فتح القاعدة بشكل طبيعى أم أنه طلب منكم وضع رقم ترخيص لتشغيل القاعدة طيب فى حالة طلب رقم الترخيص من فضلك انسخ رقم الـ Activation Number من النموذج من خلال زر الامر Copy وقم بلصقه هنا فى مشاركة للتأكد من فاعلية الفكرة سوف أرسل لكم رقم ترخيص License Number لفتح القاعدة وبعد ذلك سوف تعمل بنجاح الى ان يتم نقلها لجهاز اخر وستتوقف عن العمل ولن يتم فتحها بنفس الرقم السابق والذى أرسلته اليكم ملاحظة رقم الترخيص يتغير من جهاز لاخر يعنى الشخص الذى سوف ارسل لع رقم الترخيص يخص جهازه الحالى فقط ولن ينفع مع شخص غيره ممكن نجرب سويا Anti Copy 3.zip

السلام عليكم ورحمة الله وبركاته هناء : * برنامج يقوم بحساب ( تكلفة البناء ) مصمم على أوفيس 2003 * المعطيات أصحاب الشأن * أمل ان يكون عملا موفق ونافع والله من وراء القصد الشكر الجزيل لمن قدم لنا معلومة في هذا المنتدى ولمن ترك معلومة في المنتديات الأخرى واستفدنا منها Building.rar

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

سؤالك وجيه استاذي @احمد الفلاحجي..فكرة استخدام Mid جاءتني بحدود ماموجود في السؤال..وبالتاكيد سوف لن تعمل في حدود سؤالك شكرا لك استاذي العزيز ...وعلى قول استاذنا جعفر ان مشاركة اكثر من راي يفتق الاذهان

حياك الأخ سامي 🙂 ضبطت لك الكود الخاص بالـ PDF : Dim reportName As String Dim fileName As String reportName = "rptsubschool" fileName = Application.CurrentProject.Path & "\" & "Schools" & "\" & frmSubSchool!ename & ".pdf" If Len(Dir(Application.CurrentProject.Path & "\" & "Schools" & "\", vbDirectory)) = 0 Then MkDir (Application.CurrentProject.Path & "\" & "Schools" & "\") DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, fileName, True 'End If End Sub السطر التالي أضفته ليتأكد من أنه شي مجلد اسمه Schools بجانب قاعدة البيانات .. لأنه أعطاني خطأ لما ما لقيه .. If Len(Dir(Application.CurrentProject.Path & "\" & "Schools" & "\", vbDirectory)) = 0 Then MkDir (Application.CurrentProject.Path & "\" & "Schools" & "\") وكذلك صلحت لك مصدر بيانات التقرير ليكون مطابق للمدرسة المختارة في صفحة البحث .. باقي عليك تضبط حجم التقرير لأنه أعرض من صفحة ال A4 لذلك ينقسم التقرير لصفحتين 🙂 المرفق : تعديل نموذج الفرز مهم.accdb

السلام عليكم ورحمة الله وبركاته بعد ان استفاضنا فى المناقشات فى هذه المشاركة http://www.officena.net/ib/topic/63756-نسخ-قاعدة-بيانات-الجداول-المرتبطة-فقط-عند-الخروج/ وقام استاذنا ابوخليل بامدادنا بكود اكثر من رائع .. فبارك الله فيه وجزاه الله عنا كل الخير له ولاولاده Shell "cmd.exe /C copy " & """" & DBOld & """" & " " & """" & _ DBNew & "\" & Format(Now(), "yymmddhhnn") & ".mdb" & """", 0 فخطرة ببالى فكرة تطوير اداه (لضبط خيارات النسخة الاحتياطية للجداول المرتبطة عن طريق قاعدة الواجهات كل فترة زمنية بطريقة تلقائية ساعة / يوم / شهر / سنة) والكود الذى امدنا به استاذنا العزيز ابو خليل يتحكم فى الموضوع ولكن من داخل الكود ــ بمعنى لو انت حبب تعمل نسخة كل ساعة عند الخروج من البرنامج لازم ترجع للكود وتحذف hh وهكذا على النحو المشار بالمشاركة المدرج رابطها بعاليه yymmddhhnn الفكرة تتلخص فى نموذج تظبط منه الاعدادات التالية وتحفظ الاعدادات لمرة واحدة واذا ارات تغيير الاعدادات عليك بالذهب الى النموذج واعادة الضبط مرة اخرى وهكذا انظر الصورة المطلوب هو التعديل على الكود حتى يتناسب مع النموذج المرفق حسب ما هو مبين بالصورة مرفق القاعدة main1.rar برجاء فك الضغط داخل البارتشن ال D محمد سلامة main1.rar

جزاكم الله كل الخير ,,, موضوع كتير مميز ومفيد جداً لقد أفادني كثيرا . شكراً لكل من ساهم ومنكم نستفيد ونتعلم أنتم السباقون بالخير دائماً . كل عام وأنتم بخير ودمتم بخير دائماً وأبداً

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

حاول تعديل الإعدادات الإقليمية لديك من لوحة التحكم أو جرب هذا الكود NoToText Function NoToTxt(TheNo As Double, MyCur As String, MySubCur As String) As String Dim MyArry1(0 To 9) As String Dim MyArry2(0 To 9) As String Dim MyArry3(0 To 9) As String Dim Myno As String Dim GetNo As String Dim RdNo As String Dim My100 As String Dim My10 As String Dim My1 As String Dim My11 As String Dim My12 As String Dim GetTxt As String Dim Mybillion As String Dim MyMillion As String Dim MyThou As String Dim MyHun As String Dim MyFraction As String Dim MyAnd As String Dim i As Integer Dim ReMark As String If TheNo > 999999999999.99 Then Exit Function If TheNo < 0 Then TheNo = TheNo * -1 ReMark = "يتبقى لكم " Else ReMark = "فقط " End If If TheNo = 0 Then NoToTxt = "صفر" Exit Function End If MyAnd = " و" MyArry1(0) = "" MyArry1(1) = "مائة" MyArry1(2) = "مائتان" MyArry1(3) = "ثلاثمائة" MyArry1(4) = "أربعمائة" MyArry1(5) = "خمسمائة" MyArry1(6) = "ستمائة" MyArry1(7) = "سبعمائة" MyArry1(8) = "ثمانمائة" MyArry1(9) = "تسعمائة" MyArry2(0) = "" MyArry2(1) = " عشر" MyArry2(2) = "عشرون" MyArry2(3) = "ثلاثون" MyArry2(4) = "أربعون" MyArry2(5) = "خمسون" MyArry2(6) = "ستون" MyArry2(7) = "سبعون" MyArry2(8) = "ثمانون" MyArry2(9) = "تسعون" MyArry3(0) = "" MyArry3(1) = "واحد" MyArry3(2) = "اثنان" MyArry3(3) = "ثلاثة" MyArry3(4) = "أربعة" MyArry3(5) = "خمسة" MyArry3(6) = "ستة" MyArry3(7) = "سبعة" MyArry3(8) = "ثمانية" MyArry3(9) = "تسعة" '====================== GetNo = Format(TheNo, "000000000000.00") i = 0 Do While i < 15 If i < 12 Then Myno = Mid$(GetNo, i + 1, 3) Else Myno = "0" + Mid$(GetNo, i + 2, 2) End If If (Mid$(Myno, 1, 3)) > 0 Then RdNo = Mid$(Myno, 1, 1) My100 = MyArry1(RdNo) RdNo = Mid$(Myno, 3, 1) My1 = MyArry3(RdNo) RdNo = Mid$(Myno, 2, 1) My10 = MyArry2(RdNo) If Mid$(Myno, 2, 2) = 11 Then My11 = "إحدى عشر" If Mid$(Myno, 2, 2) = 12 Then My12 = "إثنى عشر" If Mid$(Myno, 2, 2) = 10 Then My10 = "عشرة" If ((Mid$(Myno, 1, 1)) > 0) And ((Mid$(Myno, 2, 2)) > 0) Then My100 = My100 + MyAnd If ((Mid$(Myno, 3, 1)) > 0) And ((Mid$(Myno, 2, 1)) > 1) Then My1 = My1 + MyAnd GetTxt = My100 + My1 + My10 If ((Mid$(Myno, 3, 1)) = 1) And ((Mid$(Myno, 2, 1)) = 1) Then GetTxt = My100 + My11 If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My11 End If If ((Mid$(Myno, 3, 1)) = 2) And ((Mid$(Myno, 2, 1)) = 1) Then GetTxt = My100 + My12 If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My12 End If If (i = 0) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then Mybillion = GetTxt + " مليار" Else Mybillion = GetTxt + " مليارات" If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " مليار" If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " ملياران" End If End If If (i = 3) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then MyMillion = GetTxt + " مليون" Else MyMillion = GetTxt + " ملايين" If ((Mid$(Myno, 1, 3)) = 1) Then MyMillion = " مليون" If ((Mid$(Myno, 1, 3)) = 2) Then MyMillion = " مليونان" End If End If If (i = 6) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then MyThou = GetTxt + " ألف" Else MyThou = GetTxt + " آلاف" If ((Mid$(Myno, 3, 1)) = 1) Then MyThou = " ألف" If ((Mid$(Myno, 3, 1)) = 2) Then MyThou = " ألفان" End If End If If (i = 9) And (GetTxt <> "") Then MyHun = GetTxt If (i = 12) And (GetTxt <> "") Then MyFraction = GetTxt End If i = i + 3 Loop If (Mybillion <> "") Then If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd End If If (MyMillion <> "") Then If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd End If If (MyThou <> "") Then If (MyHun <> "") Then MyThou = MyThou + MyAnd End If If MyFraction <> "" Then If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur + " " + "لا غير" Else NoToTxt = ReMark + MyFraction + " " + MySubCur + " " + "لا غير" End If Else NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + " " + "لا غير" End If End Function

السلام عليكم في المرفق مثال لإغلاق البرنامج بعد 30 ثانية، وإذا أردت الإغلاق بعدد الدقائق قم بتغيير القيمة من خاصية حدث النموذج (الفاصل الزمني لعداد الوقت) = 60000 بدلا من 1000 البرنامج بعد فترة.accdb

=IF(C3="المعمل","حسين",IF(C3="المشروعات","محمد",IF(C3="الحسابات","جمال",IF(C3="المالية","أحمد","")))) 1المطلوب .xlsx

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

تفضل استاذ احمد...عذرا لم انتبه test(2)(1).accdb

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

=VLOOKUP(C3,Q8:S12,2,0) حسب الجدول المرفق

السلام عليكم بالإذن ممكن خيار آخر C2=CHOOSE(A2,8.33,9.09,10,11.11)*B2 وفاء 2021.xlsx

السلام عليكم الصفحتين بالاول ليس لهم علاقة بالصفحة الجديده انظري للمرفق واخبريني اي تعديل SSS3-test.xlsx

احسنت وزادك اله علما لتنفع به الاخرين امثالي

Try to get this line well .Range("K" & n).Resize(, 3).Value = Array(.Range("A" & r).Value & vbLf & .Range("A" & r + 1).Value, .Range("B" & r).Value & vbLf & .Range("B" & r + 1).Value, .Range("C" & r).Value & vbLf & .Range("C" & r + 1).Value) I didn't ask you to write a whole code, just understand the code to be able to modify it

السلام عليكم ورحمه الله شرح طريقة بحث وتصفية وفرز وفلترة السجلات بطريقة جديدة بدون اكواد https://m.youtube.com/watch?v=xRs4GkTEEso

تسلم جزيت خير

السلام عليكم ورحمة الله وبركاته أرجو أن تنظر في هذا الحل توزيع التلاميذ على الفصول.xlsm

حياك الله أخي @at_aziz 🙂 تفضل هذا ملف الفوتوشوب مع ملفات الصور PNG .. Form 4 Designs.rar

في الواقع موضوع واجهات HTML وتوابعها ، شيق وجميل وجديد على الاكسس ، ولكني لاحظت ان الاخ موسى عمل واجهات جميلة بالاكسس ، وببرمجة الاكسس فقط ، ولم يستطع بعض الاعضاء تطبيق الطريقة في برنامجهم ، فرجعوا الى منتدى الاكسس ، وبالاضافة الى الاخ موسى ، قام اعضاء آخرين بالرد على استفساراتهم ، كون البرمجة اكسس. القلق الذي يراودني انه ، في حال استخدام اكواد HTML وتوابعها ، فيصبح معظم الاعضاء الذين سيحاولون تذليل الكود في برامجهم ، سيكون لديهم اساله ، فالسؤال هنا ، من سيقوم بالرد عليهم ويُصلح اخطاءهم؟ لا ننسى اننا في منتدى الاكسس ، فهل نحوّل هذه الاسئلة الى منتدى الويب ، للرد على التساؤلات؟ جعفر

فكرة جديدة تدرج الوان ولا اروع سهولة ومرونة فى تغيير تدرج الالون وبدون برق ورعد فاهم قصدى طبعا يا استاذ @Moosak وبصراحة مش فاضى للتطوير اكثر فى الوقت الحالى ShowHideSideBareRight (4).zip

ايضا هذا كود اخر جميل وتعدد الخيارات بمجرد تشغيل تستطيع تحدد العمود الذي تريد من تحدف منه البيان وكذلك الكلمة او القيمة التي تريدها Sub DeleteRows() 'Updateby20140314 Dim rng As Range Dim InputRng As Range Dim DeleteRng As Range Dim DeleteStr As String xTitleId = "KutoolsforExcel" Set InputRng = Application.Selection Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8) DeleteStr = Application.InputBox("Delete Text", xTitleId, Type:=2) For Each rng In InputRng If rng.Value = DeleteStr Then If DeleteRng Is Nothing Then Set DeleteRng = rng Else Set DeleteRng = Application.Union(DeleteRng, rng) End If End If Next DeleteRng.EntireRow.Delete End Sub

أولا إنشاء مجلد على الدي يحمل اي اسم مثلا ( نسخ احتياطي ) أو ( Backup ) ثم نذهب إلى البرنامج ونحدد المجلد المذكور في نافذة تحديد مكان تحديد النسخ