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

@فايز.. @ابوآمنة هذا تعديل على كود الاستاذه زهره ولماطلبت بنفس الرسائل Dim strSearch As String Dim rs As Object Set rs = Me.RecordsetClone If IsNull(Me![txtSearch]) Or (Me![txtSearch]) = "" Then MsgBox "رجاء ادخل اسم للبحث عنه", vbOKOnly, "خطأ في البحث" Me![txtSearch].SetFocus Exit Sub End If strSearch = Me![txtSearch] With rs .FindNext "[EmpName] like '*" & strSearch & "*'" If Not .EmpName Like "*" & strSearch & "*" Then MsgBox "لا يوجد سجل بهذا الإسم : " & strSearch, , "غير موجود" Me.txtSearch = "" Me![txtSearch].SetFocus ElseIf .NoMatch Then MsgBox "آخر سجل في البحث عن : " & strSearch, , "آخر سجل" Me.cmdSearch.Caption = "بحث" Me.txtSearch = "" Me![txtSearch].SetFocus Me.cmdSearch.ForeColor = RGB(0, 0, 255) DoCmd.GoToRecord , , acFirst Else Me.Bookmark = .Bookmark MsgBox "تم ايجاد اسم : " & strSearch, , "مبروك" Me.cmdSearch.Caption = "اكمال البحث" Me.cmdSearch.ForeColor = RGB(255, 0, 0) End If End With rs.Close Set rs = Nothing بالتوفيق

وعليكم السلام اخى @husamwahab منور جزاك الله خيرا زياده الخير خيرين ومنى تعديل طفيف عالسابق بعد تجربته لم يكن يسجل القيم فعدلته بتعديل طفيف استفدته من اخى واستاذى @kha9009lid جزاه الله خيرا بالتوفيق اخوانى مربح تحرير وسرد(1).accdb أحسنت اخى حسام جزاك الله خيرا

السلامة عليكم من رخصة الاستاذ أحمد الفلاحجى هذه مشاركة مني Root15.rar

تفضل اخي

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

انا استرديت حسابى مرة اخرى على الموقع

بعض التجسينات على الكود (لتحديد الصفوف المطلوبة للجمع حسب التواريخ) Option Explicit Sub Get_Sum_By_Array() Dim Main As Worksheet Dim Sh As Worksheet Dim Start_Date As Date, Final_date As Date Dim Last_Row%, i%, m%, AL_Result# Dim arr() Set Main = Sheets("Salim") Start_Date = Main.Cells(2, 3) Final_date = Main.Cells(2, 4) For Each Sh In Sheets If Sh.Name <> Main.Name Then Last_Row = Sh.Cells(Rows.Count, 1).End(3).Row Sh.Range("A5:I" & Last_Row).Interior.ColorIndex = xlNone For i = 5 To Last_Row If Sh.Cells(i, 1) >= Start_Date And _ Sh.Cells(i, 1) <= Final_date Then Sh.Cells(i, 1).Resize(, 9) _ .Interior.ColorIndex = 6 ReDim Preserve arr(m) arr(m) = _ Application.Sum(Sh.Cells(i, 1). _ Offset(, 4).Resize(, 5)) m = m + 1 End If Next i If m > 0 Then Sh.Cells(4, 2) = Application.Sum(arr) AL_Result = AL_Result + Application.Sum(arr) Else Sh.Cells(4, 2) = 0 AL_Result = AL_Result End If Erase arr: m = 0 End If Next Sh Main.Cells(2, 2) = AL_Result Set Main = Nothing: Set Sh = Nothing End Sub الملف من جديد Total_sum_Super.xlsm

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

1-لم اجد ورقة اسمها النقدية في الملف 2- كما لم اجد اي صف فيه كلمة اجمالي ربما تريد هذا الماكرو الذي يضع لك اجمالي كل صفحة حسب التاريخ في كل ورقة (الخلية B2 ) Option Explicit Sub Get_Sum_By_Array() Dim Main As Worksheet Dim Sh As Worksheet Dim Start_Date As Date, Final_date As Date Dim Last_Row%, i%, m%, AL_Result# Dim arr() Set Main = Sheets("Salim") Start_Date = Main.Cells(2, 3) Final_date = Main.Cells(2, 4) For Each Sh In Sheets If Sh.Name <> Main.Name Then Last_Row = Sh.Cells(Rows.Count, 1).End(3).Row For i = 5 To Last_Row If Sh.Cells(i, 1) >= Start_Date And _ Sh.Cells(i, 1) <= Final_date Then ReDim Preserve arr(m) arr(m) = _ Application.Sum(Sh.Cells(i, 1). _ Offset(, 4).Resize(, 5)) m = m + 1 End If Next i If m > 0 Then Sh.Cells(4, 2) = Application.Sum(arr) AL_Result = AL_Result + Application.Sum(arr) Else Sh.Cells(4, 2) = 0 AL_Result = AL_Result End If Erase arr: m = 0 End If Next Sh Main.Cells(2, 2) = AL_Result Set Main = Nothing: Set Sh = Nothing End Sub الملف من جديد Total_sum_New.xlsm

وعليكم السلام اخى @ازهر عبد العزيز مشاركه مع اخى واستاذى محمد @Barna جزاه الله خيرا محاوله منى على قد ما فهمت شوف استعلام التوحيد الاستعلام 3 ممكن تبنى عليه التقرير اذا كان ما تريد بالنسبه للنموذج كما قال استاذى العزيز محمد استخدم النماذج الفرعيه وممكن فالتقارير برضه بالتوفيق ان شاء الله VID(1).accdb

اعتذر كنت فهمت الموضوع خطأ .. كنت أظنك تبحث عن كود لعمل مجلد جديد .. فأرفقت الملف في الرد الأول .. يا الله .. انا في حرج منك .. أخي عبد اللطيف ..

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

بالخدمة اخي الكريم

السلام عليك تفضل اخي العزيز ارجو ان يكون طلبك نقل فورم.rar

لا وانما قصدي اعمل الاستعلام بالطريقة العادية مرة ثانية ، واذا اشتغل ، فيمكنك ان تأخذ جملة الـ SQL للكود 🙂 او طبعا اذا ممكن استعمال الاستعلام ، فلماذا الكود اصلا 🙂 جعفر

شوف هنا لمعلومات اكثر حيث اكتب من الموبايل يمكن تختصر ب currentdb.properties(“allowfullmenus”)=false بالتوفيق

تفضل لك ما طلبت وهذه أسماء وكلمات السر للمتخدمين مع الصلاحيات ... والصفحة التى بها الفورم الذى تعمل عليه هى صفحة إدخال البيانات ..... وكلمة السر دائماً للدخول لصفحة الصلاحيات هى 123 اسم المستخدم كلمة المرور صفحة الادخال صفحة الاستعلام قاعدة البيانات Yasser 123 yes yes yes aseel 111 yes no yes mohamed 222 no no no بيانات الموظفين.xlsm

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

اخى @عبد اللطيف سلوم ع ما اعتقد عندك مثال جاهز للمساعده وجزاك الله خيرا

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

جميل جدا روعة

بالنسبة لموضوع الصلاحيات فيمكنك متابعة هذا بنفسك من خلال عدة مشاركات بالمنتدى تم تداول هذا الموضوع بها ومنها : برنامج صلاحيات المستخدمين الاصدار 3 حماية ملف اكسل من داخل الملف + صلاحيات لكل مستخدم + سجل لأسماء و مواعيد الدخول للملف شاشة دخول مع صلاحيات برنامج صلاحيات المستخدمين - بشكل جديد نموذج دخول بصلاحيات الاطلاع على أوراق العمل صلاحيات للوصول لشيتات صلاحيات الدخول للمستخدمين وهذه فيديوهات شرح https://www.youtube.com/watch?v=zGopdxUQCQU https://www.youtube.com/watch?v=JxrjmUW_UoA

تم دمج الحسابين فى الحساب الاصلي المستعاد

تفضل اخي اتبع ما موجود في الصور ثم ضع هذا الكود تاكد من مسار الصورة حتى لايحدث خطا معك في الكود Private Sub UserForm_Initialize() Me.WebBrowser1.Navigate2 "C:\Download\1.gif" End Sub

ابشر اخي الان اصور فيديو واشرح الطريقة بالتفصيل ان شاء الله

عادي صديقي ما في حرج بالعكس استفدنا من الكود الجديد

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

السلام عليكم 🙂 مسألة Garbage in, garbage out (اذا تم ادخال بيانات خطأ، فالنتائج تكون خطأ) تنطبق على كل جزئية من بيانات قاعدة البيانات ، وليس التاريخ فحسب ، رجاء انظر في الرابط اللي وضعته انا في مشاركتي اعلاه : وستلاحظ فيه ان المستخدم اخطأ في ادخال تاريخ اليوم ، فسنة 2001 سنة كبيسة ولا يوجد فيها 29 يوم : 1. هذا مستحيل ، والتجارب اثبتت هذا ، فأنت تتعامل مع أناس من مختلف الطبقات ، وانا بنفسي شفت المهمل اللي يرمي مسؤوليه اخطاءه على البرنامج ، 3. وحتى هذه الطريقة لا يمكن الاعتماد عليها ، فالمثال من الموضوع الآخر يثبت هذا الشيء. ستقول يجب ان نتأكد من الادخال ، والذي معناه الرجوع للمادة رقم 2 مرة اخرى 🙂 2. وهذه هي الطريقة الصحيحة ، وهي محور كلام هذا الموضوع ، وهي استعمال الاوامر الصحيحة لقراءة التاريخ بالطريقة الصحيحة ، وهي وكما شرحتها انا بمثال في المشاركة التي وضعت رابطها ، وهي ان الاكسس يتعامل مع التواريخ بالتنسيق الامريكي شهر/يوم/سنه ، فيا نتعامل معها بهذه الطريقة ، وهي كما شرحها اخوي خالد : . او اوامر التاريخ التي تنص على مكان اليوم و الشهر والسنه ، مثل DateSerial : DateSerial(Year_السنة , Month_الشهر , Date_اليوم ) جعفر

علي حسب ما فهمت للالغاء Docmd.showToolbar "Ribbon", actoolbarNo

صدقا انا اود مساعدتك لكن لا انصح بان يكون الليست بوكس به اكثر من 10 اعمدة سيكون البرنامج ثقيل ويبطيء من عمله وقد يتوقف يوجد طرق لكن ليست عملية وانا جربتها لانه على حد ما فهمت منك لديك بيانات كثيرة في ورقة العمل وبالتالي يجب ان تاخد هذا العامل بعين الاعتبار كلما كانت البيانات كثيرة في اوراق العمل قلت سرعة البرنامج لذا انا اقترح عليك تقسيم البيانات في اوراق العمل وايضا تقسيم الليست بوكس بتصميم اكثر من يوزرفورم عذرا على الاطالة ولكن اردت توضيح بعض النقاط جرب هذه الاكواد ل10 اعمدة فقط واذا كانت بياناتك اكثر من 10 اعمدة اعلمني لعلي اجد طريقة لذلك Private Sub CommandButton1_Click() Dim iX As Integer With Me.ListBox1 .AddItem For iX = 1 To 10 .List(.ListCount - 1, iX - 1) = Me("textbox" & iX).Value Next iX End With End Sub Private Sub CommandButton2_Click() Dim lRw As Long With æÑÞÉ1 lRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 .Cells(lRw, 1).Resize(Me.ListBox1.ListCount, Me.ListBox1.ColumnCount).Value = Me.ListBox1.List End With End Sub

اخي @فايز.. بما انك مش فاهم الكود تبع الاستاذ زهرة وناسبك كود الاستاذ ابو امنه هذا تعديل على كود الاستاذ @ابوآمنة وبعد اذنه Private Sub cmdSearch_Click() If IsNull(Me.txtSearch) Then Me.FilterOn = False: Exit Sub Me.Filter = "[StName] like '*" & txtSearch & "*'" Me.FilterOn = True If Me.StName Like "*" & txtSearch & "*" Then MsgBox "موجود" Else MsgBox "غير موجود" End Sub ولاحظ ان الكود يفلتر السجلات اي السجلات التي ستكون بالنموذج فقط نتائج البحث دون السجلات الاخرى وهنا - ميزة : عند النقر على زر التالي ستجد السجلات الاخرى لنفس البحث . مثلا لوكتب القحطاني سياتيك سجلات الذين يحتوون على القحطاني فقط وتتنقل بالزر التالي الاول تلو الاخر - عيوب : ستفقد السجلات الاخرى .. فلو اردت البحث عن اسم اخر لن تجده لان السجلات اصبحت فقط للبحث السابق القحطاني . وهنا لابد من الغاء الفلتره لعودة جميع السجلات والبحث مره اخرى .. لالغاء الفلتره فقط استخدم me.filteron=false ولكن اين تضعه شوف اللي يناسبك وممكن يكون بزر جديد بالتوفيق

المطلب غير مفهوم : هل تريد كل بيانات جدول بشكل منفصل ؟؟؟؟ اذا كان الجواب نعم اصنع نماذج فرعية وتقارير فرعية

السلام عليكم مشاركة مع استاذنا الفاضل Khalid Jnb تفضل اخي الكريم نفس طريقة وعمل المحترم Khalid Jnb زلكن بدون ذز الاضافة يعني غيرت فقط مكان الحدث نتمني ان يكون المطلوب قاعدة البيانات3 (1).mdb

السلام عليكم تفضل اخي الكريم انظر استعلام باسم Query1 الموظفين.rar مع اني اتنصحك بتقسيم جدول الموظفين الى جدولين الجدول الاول خاص بالبيانات والجدول الثاني خاص بالعلاوات ( رقم الموظف - التاريخ - رقم العلاوة ) تحياتي

أستاذ رسول هادي أين الضغط على الإعجاب لكل هذه الإجابات ؟!!!💙

جرب هذا الكود Option Explicit Sub Colorize_Dupicates() Dim Sh As Worksheet, A As Worksheet Dim Rg As Range, cel As Range, _ Act_Rg As Range, F_rg As Range Dim Fadr$, Sadr$ Dim D As Object Dim i%, X%, y% Set Sh = ActiveSheet Set Rg = Sh.Range("a1").CurrentRegion.Columns(1).Cells X = Sh.Cells(Rows.Count, 1).End(3).Row Sh.Range("C1:z" & X).Clear Set D = CreateObject("Scripting.Dictionary") Rg.Interior.ColorIndex = xlNone For Each A In Sheets A.Range("a1").CurrentRegion.Columns(1) _ .Interior.ColorIndex = xlNone A.Range("C1:z100").Clear Next For Each cel In Rg For Each A In Sheets If A.Name <> Sh.Name Then Set Act_Rg = A.Range("a1").CurrentRegion.Columns(1) X = A.Cells(Rows.Count, 1).End(3).Row Set F_rg = Act_Rg.Find(cel, lookat:=1) If F_rg Is Nothing Then GoTo Next_A cel.Interior.ColorIndex = 6 Fadr = F_rg.Address: Sadr = Fadr Do F_rg.Interior.ColorIndex = 6 D(A.Name & " :Row (" & F_rg.Row & ")") = vbNullString Set F_rg = Act_Rg.FindNext(F_rg) Sadr = F_rg.Address If Sadr = Fadr Then Exit Do Loop End If Next_A: Next A If D.Count > 0 Then With cel.Offset(, 2).Resize(, D.Count) .Value = D.keys .Borders.LineStyle = 1 .Interior.ColorIndex = 38 .InsertIndent 1 End With With cel.Offset(, 2 + D.Count) .Value = IIf(D.Count = 1, "1 Duplicate", D.Count & " Duplicates") .Borders.LineStyle = 1 .Interior.ColorIndex = 6 .InsertIndent 1 End With Else With cel.Offset(, 2) .Value = "No Duplicates" .Borders.LineStyle = 1 .Interior.Color = vbGreen .InsertIndent 1 End With End If D.RemoveAll Next cel End Sub الملف مرفق Count_Tekrars.xlsm

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

جزاك الله خيرا اخى @عبد اللطيف سلوم اتمنى تشرح لى باستفاضه اخى العزيز بارك الله فيك

تسلم

احسنت يا ابا اشرف

اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف

اشكرك صديقي على اثراء الموضوع

تفضل أخي الكريم هذا الملف بحثت لك فوجدت هذا الملف انسخ الأكواد منه وضعها في ملفك .. AZ_mkdir.mdb

الاخوة الزملاء في هذا المنتدى اريد مساعدتكم في اكواد وذلك كما يلي في صفحة الرئيسية هناك خيارين اريد كود في حال اختيار ادخال معلومات جديده بحيث ان النتيجة المتوقعة ان" جميع الاعمده في ورقة الداتا بيس تكون في الجدول في الصفحة الرئيسية ومن ثم يتم ادخال المعلومات الجديده وترحل الى الداتا بيس بنفس تنسيق ورقةCM-50-1070 في نفس الوقت يتم انشاء ورقة تحمل نفس رقم الكود المدخل لهذه البيانات الجديده اريد كود في حيال خيار بحث وتعديل حيث ان البحث يكون اما في الداتا بيس وذلك بادخال رقم الكود فقط وتاتي البيانات بنفس المثال اللي فوق في الجدول في الصفحة الرئيسية ويتم التعديل ومن ثم الحفظ في كل من الداتا بيس والورقة التي تحمل رقم الكود في حال البحث عن جميع الاوراق يم البحث عن طريق رقم الكود بادخال اخر ثلاث او اربع ارقام او عن طريق اسم ممثل المصنع بادخال احرف من اسمه وتكون النتيجة بجلب الكود ورقمه لجميع الاوراق تحت اسمه في الجدول في الصفحة الرئيسة وفي حال دبل كليك يتم التحويل لنفس الورقة Help.xlsx

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

اخي الكريم كان عليك تحديد نقطة واحدة مثلا طلب ادخال بيانات جديدة وشرح المطلوب جيدا مع ادخال بعض البيانات في الداتا بيس كنمودج ويكفي صفين اعادة تصميم الصفحة المصدرة للبيانات ( عدد عناوين الجدول في الداتا اكبر من عدد عناوين الجدول في main) حاول ايصال ما تريد بطريقة جيدة وخطوة خطوة . وانشاء الله تجد مساعدة من الاساتذة تحياتي

ممكن ان يكون المطلوب Option Explicit Sub Join_data_NEW() If ActiveSheet.Name <> "Salim" Then Exit Sub Dim i%, Dic As Object, k, my_key, ARR Set Dic = CreateObject("Scripting.Dictionary") Cells(3, "H").CurrentRegion.Clear Cells(3, "AA").CurrentRegion.Clear i = 3 Do Until Cells(i, "E") = vbNullString k = Cells(i, "F") If Not Dic.Exists(Cells(i, "E").Value) Then Dic(Cells(i, "E").Value) = k Else Dic(Cells(i, "E").Value) = Dic(Cells(i, "E").Value) & "," & k End If i = i + 1 Loop Cells(3, "H").Resize(Dic.Count) = Application.Transpose(Dic.keys) i = 3 For Each my_key In Dic.keys Cells(i, "I") = Dic(my_key) & "." i = i + 1 Next my_key i = 3 '+++++++++++++++++++++++++++ Cells(3, "AA").Resize(Dic.Count) = Application.Transpose(Dic.keys) For Each my_key In Dic.keys ARR = Split(Dic(my_key), ",") Cells(i, "AB").Resize(, UBound(ARR) + 1) = ARR i = i + 1 Next my_key '+++++++++++++++++++++++++++ Set Dic = Nothing With Cells(3, "H").CurrentRegion .Interior.ColorIndex = 6 .Borders.LineStyle = 1 .InsertIndent 1 .Font.Bold = True End With Cells(3, "H").CurrentRegion.Columns(1) _ .Interior.ColorIndex = 38 With Cells(3, "AA").CurrentRegion.SpecialCells(2) .Interior.ColorIndex = 28 .Borders.LineStyle = 1 .InsertIndent 1 .Font.Bold = True End With Cells(3, "AA").CurrentRegion.Columns(1) _ .Interior.ColorIndex = 38 End Sub الملف مرفق للمعاينة talabia_SL _Plus.xlsm

السلام عليكم ورحمة الله ضع هذا الكود فى حدث ThisWorkbook Private Sub Workbook_SheetActivate(ByVal Sh As Object) For i = 1 To Sheets.Count Sheets(i).Range("A1").Value = i Next End Sub

السلام عليكم ورحمة الله وبركاته هل يمكن عمل دالة بحيث اذا اخترت رقم في النوع تقوم بتعبئة البيانات التالية بدلا من ادخالها يدوياً . ww1.xlsx

وعليكم السلام-فقط يمكنك استخدام هذه المعادلة =IFERROR(INDEX($R$8:$AA$12,MATCH($E7,$Q$8:$Q$12,0),MATCH(F$6,$R$7:$AA$7,0)),"") ww2.xlsx