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

يجب نوع الخط Wingdings 2 لهاتين العلامتين فقط لإدراج علامة صح اضغط مفتاحي shift+p ولإدراج علامة × اضغط مفتاحي shift+o أو ممكن من قائمة إدراج اختر رمز ومن المربع الحواري اختر رموز ثم اختر نوع الخط Wingdings 2 واختر الشكل رقم 80 لإدراج علامة صح والشكل رقم 79 لإدراج علامة ×

السلام عليكم 🙂 برامج الاكسس ممكن ان يصيبها العطب corruption لعدة اسباب ، وبرامج تصليح العطب يجب ان تكون من ضمن مكتبة برامج المبرمج 🙂 يُعتبر برنامج DataNumen Access Repair من احد البرامج المهمة في اصلاح ملفات الاكسس المعطوبة ، والآن الشركة تعطي النسخة الاحدث 2.9 للإستعمال الشخصي الغير تجاري ، مجانا ، من موقعهم : https://www.datanumen.com/access-repair/ انزلته وجربته ، بس لاحظت ان البرنامج بطيء بالمقارنة مع بعض البرنامج الاخرى ، ولكن لا تنسى أنها نسخة مجانية (للإستعمال الشخصي الغير تجاري) 🙂 جعفر رجاء استعمل رابط الشركة حتى تنزل آخر نسخة هناك ، بينما ارفق هنا النسخة 3 (احتياطا ، اذا غيرت الشركة رأيها لاحقا والغت النسخة المجانية ، فتكون عندنا هنا النسخة المجانية 🙂 ) daccr.zip

السلام عليكم ورحمة الله وبركاته أعتقد أن خيار تكبير قاعدة البيانات والارتباط بالــ SQL Server سيكون خيارا مناسبا في حالتك حيث يمكنك الاتصال بقاعدة البيانات من التطبيق ومن برنامج الأكسس علي حد سواء. أما عن الشير بوينت فليس لي كبير علم به ولكن أعتقد أنه بحاجة لتعديل جزري ببرنامج الأكسس لكونه يحتاج تطبيق أكسس خاص بالانترنت وليس الدسكتوب! اليك هذين الرابطين لتوضيح الفكرة: والرابط الثاني: أرجو أن تنتفع بها

ما تطلبه ليس بالسهل أو الهين فتعتبر أكواد فورم كامل ولابد من رفع الملف نفسه فلا يمكن العمل بدون ملف !!!

اعرض الملف اضافة محتوى القائمة المنسدلة آليا السلام عليكم I needed to Autofill the validation dropdown list with specific values for a large number of cells For a cell corresponding to Row B and Column C , I wanted the drop down to show those values CCCC,CCC,CC,C,CB,B,BB,BBB,BBBB and so on for the rest of the matrix The First step was to prepare the dropdown required contents using equations as shown on the table to the right side السلام عليكم أردت ملء بيانات القائمة المنسدلة لعدد كبير من الخلايا ضمن مصفوفة بحيث يكون متوى القائمة المنسدلة عند تقاطع العمود المعنون ب حرف C مع الصف المعنون بحرب B كالتالي CCCC,CCC,CC,C,CB,B,BB,BBB,BBBB و عليه فالخطوة الاولي قمت بتجهيز المحتوى المطلوب عن طريق المعادلات فى الجدول على اليمين كما هو مبين فى الصورة التالية Next i prepare the following VBA code , which reads the values from the above table and add them to the dropdown list contents for all selection cells The code reads the values 11 cells to the left ,of the target cell , and you can change that of course based on your case و الخطوة التالية كانت اعداد الكود المطلوب لتنيذ العملية كما هو مبين أدناه حيث يقوم الكود بقراءة المحتوى من الجدول اعلاه و اضافته ضمن القائمة المنسدلة لكل الخلايا فى الجدول على اليمين و الكود تم اعداده ليضف فى محتوى القائمة المنسدلة لكل خلية فى الجدول القيمة فى الخلية على بعد 11 عمود الي اليمين فى الجدول السابق، و طبعا يمكن تعديل هذه القسمة بحسب الجدول السابق Sub FillDropDown() Dim myrow As Byte, mycol As Byte, TargetVal As String myrow = Selection.Rows.Count mycol = Selection.Columns.Count mycell = ActiveCell.AddressLocal For i = 0 To myrow - 1 For j = 0 To mycol - 1 Range(mycell).Activate ActiveCell.Offset(i, j).Activate '11 is the number of cells the source value exist to the right of the target cell TargetVal = ActiveCell.Offset(0, 11).Value With ActiveCell.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=TargetVal .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With Next j Next i End Sub To run the code , add it in a module in your file , and make sure the file is saved as macro-enabled excel file then select all the target cells in the left side table , Press Alt+F8 , then choose the code قم باضافة الكود لملفك، و تأكد من حفظ الملف بصيغة تفعيل الماكرو macro-enabled excel file ثم قم باختبار كافة الخلايا المستهدفة اضغط ALT+F8 شغل الكود You will find that all cells in the target table has now the required dropdown list contents as targeted ستجد أن كافة الخلايا التي تم اختيارها قتم تم اضافة قائمة منسدلة لها بالمحتوى المطلوب كما هو مبين فى الصورة The Reason behind developing this code was that i needed to fill the dropdown lists in 225 cell with variable contents in this example related to using Analytic Hierarchy Process (AHP) technique to compute relative weights for any evaluation criteria ملاحظة: أضفت المحتوى باللغة الانجليزية ايضا لدراسة تأثير ذلك على انتشار المشاركة كما يقولون الحاجة ام الاختراع ، فقط احتجت لهذا الأمر لملء 225 خلية بقوائم منسدلة ذات محتوى متغير فى هذا المثال الخاص بالأوزان النسبية لمعايير التقييم صاحب الملف محمد طاهر تمت الاضافه 19 مار, 2021 الاقسام قسم الإكسيل

اعرض الملف تحديد الأوزان النسبية و التقييم + تطبيق بالإكسيل عند مقارنة خيارات متعددة وفقا لمعايير محددة ، يتم أولا تحديد وزن نسبي لكل من هذه المعايير حتى نستطيع الوصول الى قرار و هنا سنعرض لطريقة تحديد الأوزان النسبية ، و من ثم عمل التقييم و طبعا اشهر تطبيق لذلك عند المقارنة بين المتقدمين لمناقصة معينة وفقا لعدة معايير و هنا يشتمل المثال على المقارنة بين عدة أنواع افتراضية من السيارات وفقا لمجموعة من المعايير مثل السعر و الصيانة و درجة الرفاهية و درجة الأمان ، و بناء على ذلك سنتعلم كيف نضع أوزان نسبية لكل من المعايير ، و بناء على ذلك تتم عملية المفاضلة ومرفق مثال بالاكسيل يحوي أتمتة كاملة لتطبيق الطريقة التي تم شرحها فى العرض التقديمي ، يحوى دالتين بالكود تم استخدامهما فى المقارنةو المثال معد بواسطة اكسيل 2007 صاحب الملف محمد طاهر تمت الاضافه 27 مار, 2010 الاقسام Project Management  

وعليكم السلام 🙂 مستحيل ان تعمل الحقول يدويا ، لأن كمية الحقول عندك مهولة !! فعملت كود علشان يعمل لي الوحدات النمطية ، وجملة SQL الاستعلام 🙂 تستطيع ان تحذف الجداول Data و Data2 ، انا تركتهم لك علشان تجرب الكود 🙂 يجب استعمال النموذج لتشغيل الاستعلام ، وإلا لن تحصل على نتائج الحقول المحسوبة في الاستعلام !! هذا جزء من الوحدة النمطية الخاصة بالحقول المحسوبة: Option Compare Database Option Explicit Dim rst As DAO.Recordset Dim Calc1 As Long Dim Calc2 As Long ' Function make_rst() Set rst = CurrentDb.OpenRecordset("Select * From Data") End Function Function f_nezara99(ID As Long) On Error Resume Next: rst.FindFirst "[ID]=" & ID f_nezara99 = IIf(rst![nezara] = 0, 0, IIf(rst![gazaat] >= 5, 0, rst![nezara])) End Function Function f_elawa_edafia(ID As Long) On Error Resume Next: rst.FindFirst "[ID]=" & ID f_elawa_edafia = IIf(rst![feaa] = "ادارى", 0, IIf(rst![Name] <> "", 4, 0)) End Function جعفر 1364.استعلام حسابى.accdb.zip

تفضل التعديل حسب فهمي لطلبك mvirtical-1.rar

وعليكم السلام -أهلاً بك فى منتدانا , يمكنك استخدام هذه المعادلة لتلبية طلبك =SUMPRODUCT(SUMIF(INDIRECT("'"&$B9&"'!"&"C9:C19"),C$7,INDIRECT("'"&$B9&"'!"&"D9:D19"))) Boo2.xlsx

السلام عليكم و رحمة الله و بركاته اود تعلم طريقة عمل معادلة على شكل دالة Sumif و لكن ان تكون النتيجة عبارة عن نص و ليس رقم انا عاوز نفس الموضوع النتيجه جيد Book (1) (5).xlsx

وعليكم السلام -بسيطة يمكنك استخدام هذه المعادلة =IFERROR(VLOOKUP($A1,Sheet1!$A$1:$C$300,3,0),"") Book 2.xlsx

بارك الله فيك أستاذ أحمد بدره وهذا فيديو لتدعيم وشرح لطريقة استاذنا الكريم أحمد

السلام عليكم أخي الكريم ، أستاذ سليم حصبيا بارك الله فيك وفي وقتك وجهدك بعد إذنك ، ممكن الحل بلا أكواد يكون أنسب أخي / محمد احمد العصري يمكنك الحل عن طريق فصل العمود إلي ثلاث أعمدة ثم ترتبها كما تريد أنظر الصورة

تم حذف Sheets("login").Select وتم إضافة Sheets("login").Visible = 1 Sheets("login").Activate في بداية الكود وتم لإضافة Sheets("login").Visible = 2 في نهاية الكود لأن Sheets("login") يجب أن يكون مرئي عند عمل الكود وتم إخفاء مرة أخرى بعد تشغيل الكود جرب هذا ربما يفي الغرض الملف المراد اصلاحة.xlsb

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

ممكن ، مافي مانع ، المهم انه ليس في الجدول ، في الجدول tbl_C ، تقدر تعمل LVL2 لمجموعة الاثنين و LVL3 لمجموعة الثلاثة ، يمكنك استعمال اياً من الاستعلامين ، وهنا يأتي دور التوضيح للمستخدم ، ممكن ان يكون فيه وصف المادة مثلا ، خصوصا اذا كانت الاختيارات تحتاج الى توضيح اكثر ، او انك تكتب فيها ما يساعدك على الاختيار الصحيح 🙂 جعفر

=IFERROR(IF(TODAY()=I48;"العقد إنتهى اليوم";IF(TODAY()>I48;"العقد منتهي";IF(TODAY()<H48;"لم يتم تداوله";"العقد ساري")));IF(LEFT(CELL("format";M48);1)="D";"سداد مبكر";"") )

السلام عليكم تفضل أخي الملف به ماطلبت حساب عدد أيام التأخير.xls

وعليكم السلام ورحمة الله ممكن تجعل الملف مشترك عن طريق حفظه علي السيرفر بعد تفعيل خاصية Shared

بارك الله في جهودكم

لا تأثير 🙂 1. صحيح انك حاليا لا تحتاج اليه ، ولكن قد تحتاج اليه في المستقبل ، 2. لا توجد علاقة بين كم مرة هذا الحقل موجود في الجداول ، مثلا: معلومات الحقل LVL تكتبها مرة واحدة في الجدول tbl_C ، ثم تستعملها لأكثر من جدول. لا تنسى انت فقط تقرأ/تختار من هذا الجدول ، ولكنك تحفظ المعلومة التي تم اختيارها في بقية الجداول ، واذا بعد تجربتك لازلت تحتاج الى توضيح ، ارفق مثال فيه نفس الحقل مكرر في اكثر من جدول 🙂 3. مافي اي مشكلة 🙂 جعفر

السلام عليكم ورحمة الله وبركاته أرجو أن يكون هذا قريبا مما تريد ولا تنسنا من دعوة بظهر الغيب التاريخ.accdb

وعليكم السلام 🙂 اتبع هذه الخطوات . . . . . . نعمل جدول tbl_Grades وفيه الحقول المطلوبة من ملف الجدول الذي استوردناه من الاكسل . والان نعمل استعلام الحاقي ، لنعبء به البيانات المطلوبة الى الجدول tbl_Grades ، ويجب ملاحظة الصورة اعلاه ، حيث نرى تسميات الجدولين . لنحصل على البيانات فقط ، يجب عمل معيار لأحد الحقول (الحقل الاسهل لي كان حقل obs) ، ونضع امر بإستبعاد السجلات التي لا نريد ان نلحقها في جدول tbl_Grades . والنتيجة نظيفة وجاهزة للإلحاق . . والنتيجة النهائية . جعفر import_from_Excel.zip

السلام عليكم 🙂 عند عمل اي برنامج ، يجب ان تحسب حساب اصعب الظروف لتعديل البرنامج ، لذلك ، ترى الاقتراح بأن يكون برنامجك مقسوم واجهة وجداول ، وعدم استخدام خاصية Lookup في الجدول ، وطبعا هناك اشياء اخرى ، حيث انه: لا يُسمح للمستخدم ادخال البيانات مباشرة في الجدول ، تحت اي ظرف كان ، عادة يكون البرنامج مستخدم من مجموعة مستخدمين في شبكة واحدة ، او من مستخدمين في مواقع ومدن/دول مختلفة ، ليس من السهولة الوصول اليهم لعمل التعديل ، لذا هذه النصائح هي لتسهيل عمل التعديل وارساله للمستخدم ، وبتنصيب البرنامج او وضع البرنامج في مكانه الصحيح ، نجعل البرنامج يعمل بالتعديلات الجديدة وبأقل تدخل من المستخدم ، فإذا كان البرنامج مقسوم واجهة وجداول ، فيمكننا التعديل على الواجهة ، وارسالها للمستخدم ، فيقوم البرنامج بربط نفسه مع الجداول بطريقة تلقائية (طبعا برمجيا نقوم بهذه العملية) ، ويعمل البرنامج بالتعديل ، ولكن السؤال ، كيف ممكن ان نعمل تعديل على الجداول؟ نعم برمجيا ممكن ان نعمل كود في الواجهة لتعديل الجداول ، ولكن هناك خطر كبير على البيانات لسبب او آخر ، ولا تنسى ان قيمة البرنامج في بياناته ، ولعمل التعديل ، يجب ان تكون الجداول مغلقة ، وان الكهرباء لن تنقطع خلال هذا التعديل ، وان لا يأتي حفيدك ويضرب بيده على لوحة المفاتيح ويلخبط الدنيا ، ووووو ، لهذا السبب ، نبتعد عن تعديل الجداول (وهناك من المبرمجين من يضع بعض الحقول الاضافية في الجداول ، ليس لها عمل ، واذا دعت الحاجة لحقل جديد ، فيستخدم احد هذه الحقول المجهزة مسبقا) ، ونجعل التعديل في الواجهة فقط. اما عمل Lookup في الجداول ، فبالاضافة الى صعوبة تغيير مكوناته (لا تقول ما بيحتاج الى تعديل ، كان غيرك اشطر منك ، ووقع في الفخ) ، فالصعوبة الاخرى هي لما تحتاج الي مساعدة في تعديل هذا البرنامج من مبرمج آخر ، فيضطر المبرمج لعمل مجموعة روابط بين الجداول ليصل الى المطلوب (ولازلت اعاني من احد البرنامج المرفوعة في المنتدى لعمل تعديل عليها). هنا يأتي المبتدئ ليقول ، طيب اذا فيه جميع هذه المشاكل ، ليش اكسس اعطانا هذه الخاصية ، والجواب انها مثل بعض الخواص الاخرى التي قد نستخدمها في ظروف خاصة جدا ومحكمة ، مثل الحقل المحسوب وحقل المرفقات. الطريقة الصحيحة لتعوضنا عن Lookup الجداول ، هي وضع هذه القيم في جدول آخر ، ثم بالاستعلام نربط الجدولين لنحصل على اسم القيمة بدل عن رقمها ، ويمكننا عمل جدول منفصل لكل نوع من انواع البيانات وعمل العلاقات بين الجداول(وهي الطريقة المتعارف عليها ، وهي الطريقة التي انت قمت بعملها) ، وهناك طريقة اخرى ، وهي دمج جميع هذه البيانات في جدول واحد (وبدون علاقات بين الجداول) ، وانا اقترح عليك هذه الطريقة. هكذا يكون الجدول . ولما نريد بيانات Type1 ، نعمل الاستعلام ، سواء استعلام بحد ذاته وله اسم ، او استعلام في اعدادات مصدر الصف ، حقل مربع التحرير والسرد ComboBox أو مربع القوائم ListBox . فنحصل على (وطبعا يمكنك اخفاء حقل الاسم لأنه غير لازم) . وهنا في النموذج/التقرير ، نستعمل حقل مربع التحرير والسرد 🙂 جعفر 1359.MusndWZwayid.accdb.zip

نعديل الكود (نفس النتسيق) اكنب رؤوس الأعمدة التي تريدها في الصف رقم 8 Option Explicit Sub Form_To() Dim F As Worksheet, W As Worksheet Dim max_ro%, max_col% Set F = Sheets("From") Set W = Sheets("Where") max_ro = F.Cells(Rows.Count, 1).End(3).Row max_col = F.Cells(8, Columns.Count).End(1).Column With W.Cells(8, 1) .CurrentRegion.Clear .Offset(, 9).CurrentRegion.Clear F.Cells(8, 1).Resize(max_ro - 7).Copy .PasteSpecial F.Cells(8, 2).Resize(max_ro - 7, max_col - 1).Copy .Offset(, 9).PasteSpecial End With Application.CutCopyMode = False End Sub Naser_1.xlsm

عليكم السلام والرحمة استاذ Ahmed kashoob تفضل هذه المحاولة ارجو ان تكون موفقة ملاحظة: تم انشاء زر امر لاجراء الاختبار بعد اضافة رقم الدورة والرقم الوظيفي وبداية ونهاية الدورة يمكن تبديل مكان الكود بعد التحديث لتاريخ الدورة مثلا سجل دورات الموظفين-2.rar

وعليكم السلام -تفضل لك ما طلبت هذا هو المستخدم بالقائمة الرئيسية من قائمة Data ثم Data Validation ثم بعد ذلك اختيار List ووضع هذا النطاق فى خانة Source =Classification!$A$1:$Q$1 أما القائمة الفرعية فعليك بإتباع نفس الخطوات مع وضع هذه المعادلة =OFFSET(Classification!$A$1,1,MATCH($B2,Classification!$A$1:$Z$1,0)-1,COUNTA(OFFSET(Classification!$A$1,1,MATCH($B2,Classification!$A$1:$Z$1,0)-1,20,1)),1) Classification1.xlsx

ما شاء الله عمل متقن اخي الفاضل وفكرة ايقونة تجهيز للطباعة اكثر من ممتازة بحيث تركت لي الخيار طباعة كل فاتورة على ورقة منفردة او طباعة عدة فواتير في ورقة واحدة لاننا سنستخدم الطابعة حرارية طلب تعديل بسيط << والله محرج منك بس تحملني 1- حذف رقم الفاتورة وحذف التاريخ من الجدول و الاكتفاء بالتاريخ ورقم الفاتورة في اعلى الفاتورة فقط 2- تغير مكان التاريخ اللي باعلى الفاتورة لتكون ارقام التاريخ اسفل كلمة التاريخ كما في هذا الصورة شاكر ومقدر وقتك اخي العزيز في مساعدتنا لحل مشاكلنا دمت في امان الله Tasmim Fatura_with Printing.xlsm

تم تحسين العمل كي تتم طباعة كل فاتورة على ورقة منفردة (حسب الاختيار بالضغط على زر تجهيز للطباعة في المرفق) Option Explicit Sub get_data() Application.ScreenUpdating = False Dim dic As Object Dim dic_key Dim ro# Dim i%: i = 2 Dim x_titel#: x_titel = 2 Dim lrDem# Facteur.Range("H:M").Clear lrDem = Demandes.Cells(Rows.Count, 1).End(3).Row Facteur.Range("Q1") = "رقم الفاتورة" Dim my_rg As Range Set my_rg = Demandes.Range("a1:f" & lrDem) Set dic = CreateObject("scripting.dictionary") With dic Do Until Demandes.Cells(i, 1) = vbNullString If Not .exists(Demandes.Cells(i, 1).Value) Then .Add Demandes.Cells(i, 1).Value, "" End If i = i + 1 Loop For Each dic_key In dic.keys Facteur.Range("H" & x_titel).Resize(8, 2).Value = Range("Header_Rg").Value Range("H" & x_titel + 2).NumberFormat = "0" Facteur.Range("Q2") = dic_key my_rg.AdvancedFilter 2, Facteur.Range("Q1:Q2"), Facteur.Range("H" & x_titel + 9) Range("I" & x_titel + 5) = Range("i" & x_titel + 10) Range("I" & x_titel + 5).NumberFormat = "d/m/YYY" Range("I" & x_titel + 4) = dic_key ro = Facteur.Cells(Rows.Count, "H").End(3).Row Range("M" & ro + 2) = Evaluate("SUM(M" & x_titel + 10 & ":M" & ro & ")") Range("M" & ro + 3).Value = Range("M" & ro + 2) * [D2] / 100 Range("M" & ro + 4).Value = Range("M" & ro + 2) + Range("M" & ro + 3) Range("H" & ro + 2).Resize(3).Value = Range("RESULT").Value x_titel = ro + 8 Next End With dic.RemoveAll: Set my_rg = Nothing Range("Q1:Q2").Clear Columns("H:M").InsertIndent 1 Application.ScreenUpdating = True End Sub '========================= Sub clear_data() Facteur.Range("H:M").Clear End Sub '========================= Sub Print_areas() Application.ScreenUpdating = False Dim My_Area As Range Dim last_row# Dim Serach_RG As Range Dim find_what$: find_what = "الإجمالي شامل الضريبة" Dim My_row#, Fix_row# Facteur.ResetAllPageBreaks last_row = Facteur.Cells(Rows.Count, "H").End(3).Row If last_row = 1 Then GoTo Leave_Me_Alone Set My_Area = Range("H1:M" & last_row) Facteur.PageSetup.PrintArea = My_Area.Address Set Serach_RG = My_Area.Find(find_what, after:=Range("h2")) If Not Serach_RG Is Nothing Then My_row = Serach_RG.Row: Fix_row = My_row Do Facteur.HPageBreaks.Add Before:=Range("H" & My_row + 3) Set Serach_RG = My_Area.FindNext(Serach_RG) My_row = Serach_RG.Row If My_row = Fix_row Then Exit Do Loop End If Leave_Me_Alone: Application.ScreenUpdating = True End Sub الملف الجديد مرفق Tasmim Fatura_with Printing.xlsm

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

جرب هذا الملف الصفجة Facteur الكود Option Explicit Sub get_data() Dim dic As Object Dim dic_key Dim ro# Dim i%: i = 2 Dim x_titel#: x_titel = 2 Dim lrDem# Facteur.Range("H:M").Clear lrDem = Demandes.Cells(Rows.Count, 1).End(3).Row Facteur.Range("Q1") = "رقم الفاتورة" Dim my_rg As Range Set my_rg = Demandes.Range("a1:f" & lrDem) Set dic = CreateObject("scripting.dictionary") With dic Do Until Demandes.Cells(i, 1) = vbNullString If Not .exists(Demandes.Cells(i, 1).Value) Then .Add Demandes.Cells(i, 1).Value, "" End If i = i + 1 Loop For Each dic_key In dic.keys Facteur.Range("H" & x_titel).Resize(8, 2).Value = Range("Header_Rg").Value Range("H" & x_titel + 2).NumberFormat = "0" Facteur.Range("Q2") = dic_key my_rg.AdvancedFilter 2, Facteur.Range("Q1:Q2"), Facteur.Range("H" & x_titel + 9) Range("I" & x_titel + 5) = Range("i" & x_titel + 10) Range("I" & x_titel + 5).NumberFormat = "d/m/YYY" Range("I" & x_titel + 4) = dic_key ro = Facteur.Cells(Rows.Count, "H").End(3).Row Range("M" & ro + 2) = Evaluate("SUM(M" & x_titel + 10 & ":M" & ro & ")") Range("M" & ro + 3).Value = Range("M" & ro + 2) * [D2] / 100 Range("M" & ro + 4).Value = Range("M" & ro + 2) + Range("M" & ro + 3) Range("H" & ro + 2).Resize(3).Value = Range("RESULT").Value x_titel = ro + 8 Next End With dic.RemoveAll: Set my_rg = Nothing Range("Q1:Q2").Clear End Sub '========================= Sub clear_data() Facteur.Range("H:M").Clear End Sub '========================= Tasmim Fatura.xlsm

بالنسبة للانتقال عن طريق tab لا أعرفها. لكن إذا أردت تجميد نص ما حتى لا يستطيع أحد التعديل عليه يمكنك عمل ذلك بسهولة. قم بتنزيل (المطور) إذا كان الأوفيس لديك انجليزي تجد اسمه (developer) كما في الصورة المرفقة ثم حدد على النص المراد تجميده واضغط على (تجميع) كما في الصورة . اتمنى ان تكون الطريقة مقاربة لما تريده.