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

أخي الكريم يفضل ذكر كل التفاصيل المتاحة لديك حتي يتم الوصول للحل المطلوب بمنتهى السهولة وعلى مرة واحدة لكن تجزئة المعطيات تؤدي إلى حلول غير مطلوبة حسب فهمي للمطلوب أنك تريد * وضع تسلسل يبدأ من الصف الثاني * إلى آخر صف مكتوب فيه في العمود b وليس إلى 10 * والكود يتم تطبيقه من الأكسس على كائن الشيت النشط يمكنك استعمال هذا الكود Dim I As Integer For I = 2 To .range("b" & .rows.count).end(3).row .Range("A" & I).Value = I-1 Next I بالتوفيق

يمكنك استعمال هذا التعديل Dim I As Integer For I = 2 To 11 Range("A" & I).Value = I-1 Next I بالتوفيق

انظر الصور ربما تفي بالغرض <<<<<<<>>>>>>>

آمين ولك بمثل ما دعوت وزيادة

شكرا لكم اساتذتي الاعزاء كلوا تمام استاذ @أ / محمد صالح بارك الله فيكم جميعا جعلها الله في ميزان حسناتكم تحياتي للجميع

جرب المرفق واعلمنا بالنتيجة <<<<<<<<>>>>>>> export _kanory.accdb

Sub Test() Dim w w = Evaluate("ROW(1:" & Cells(Rows.Count, "B").End(xlUp).Row - 1 & ")") Range("A2").Resize(UBound(w, 1)).Value = w End Sub

جزيل الشكر لكم جميعا

مرحبا، ربما يفيدك هذا الملف. Booking Hall.xlsm

جرب .usedRange.Columns(1).rows(2) = i

يمكنك استعمال هذا الكود في حدث عند تغيير التحديد Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 5 Or Target.Column = 7 Then Range("ad2").Value = Target.Value End If End Sub وهذا ملفك بعد إضافة الكود وتغيير الامتداد بالتوفيق Select.xlsb

عليكم السلام ورحمة الله وبركاته * بالنسبة للمطلوب الأول لا يمكن استخدام كالندر داخل الخلايا ممكن في يوزرفورم ولكن يمكنك جعل تنسيق خلية التاريخ dddd dd mmmm yyyy سيظهر اسم اليوم واسم الشهر مع التاريخ ويمكنك الاستغناء عن عمود اليوم * وبالنسبة لكتابة جميع تواريخ الشهر يمكنك في الخلية B5 كتابة المعادلة التالية =B4+1 مع نسخ المعادلة لأسفل * وبالنسبة لموضوع منع التكرار يمكن استعمال التنسيق الشرطي وتلوين الصفين المكررين وهذا ملفك بعد تنفيذ مقترحاتي بالتوفيق برنامج حجز قاعات 2021.xlsx

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

الف مليون مبروك على الترقية ونسأل الله أن ينفع بما يقدم ..

وعليكم السلام ورحمة الله وبركاته تستطيع استخدام الاستعلامات للتصدير واستخدام جمل (SQl) وتوظيفها بما تحتاجه مثلاً: SELECT DCount("1","[tb3]","[ت] <= " & [ت]) AS AutoNumber, * FROM tb3 ORDER BY [ت]; استخدم السابق في استعلام جديد وقم بتسميته مثلاً: QryTbl3 ثم قم باجراء التغييرات حسب ما تريد لبرنامجك حيث يمكنك تصدير autonumber بدل ت لملف الاكسل :: تحياتي

الف الف مبروك

الف مليون مبروك على الترقية الى درجة خبير

لن تجد حلا الا اذا وضعت مرفق

الشكر لله الذي هدانا لهذا

الف شكر لك أستاذي منكم وبكم نتعلم ونرتقي🌹

يمكنك استعمال هذه المعادلة في الخلية D6 مع نسخ المعادلة يمينا لنهاية الشهر =IFERROR(IF(OR(COUNT($C5:C5)<1,D5-MAX($C5:C5)<0),"",D5-MAX($C5:C5)),"") ويمكن نسخ الخلية D6 إلى D8 لنسخ المعادلة وهذا ملفك بعد التعديل بالتوفيق كشف الفواتير للمركبات - بوقصي 9-2021 تجارب.xlsm

هذا المطلوب لا يتم بالمعادلات لابد من تدخل جراحي (vba) يمكنك استعمال هذا الكود في حدث عند التغيير Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 3 And Target.Column >= 1 And Target.Column <= 3 And Evaluate("=counta(a3:d3)") = 4 Then lr1 = Cells(Rows.Count, 1).End(3).Row + 1 lr1 = IIf(lr1 < 4, 4, lr1) lr2 = Cells(Rows.Count, 12).End(3).Row + 1 Range("a" & lr1 & ":d" & lr1).Value = Range("a3:d3").Value Range("l" & lr2 & ":o" & lr2).Value = Range("a3:d3").Value Range("a3:c3").ClearContents End If End Sub وهذا ملفك بعد إضافة الكود وتغيير الامتداد 555.xlsb

ولا تترك عنصر تحكم او نموذج او تقرير ولا تكتب شىء في vba باي لغة غير اللاتينية / الانجليزية تحياتي

تفضل هذه المشاركة Nouveau Microsoft Access Database.accdb

استخدم هذا ... <<<<<<<<<>>>>>>>>> .usedRange.rows(1).Interior.Color = vbYellow تفضل ملفك .... export _kanory.accdb

تفضل هذا التعديل export excelw.accdb

الملف السابق هو ملف تنفيذي يلغي رسائل الأمان الخاصة بالاكسس لكن لا أعلم ما اذا كان فعال مع الاصدارات الحديثة ام لا لكنه فعال مع الاصدارات 2007 و 2010

First correct the combobox name from [Calss] to [Class] In userform module Dim ws As Worksheet, m As Long Private Sub StudentName_Enter() Dim a, i As Long, k As Long If Natija.Value <> "" And Class <> "" Then a = ws.Range("A2:D" & m).Value ReDim b(1 To UBound(a, 1)) For i = LBound(a) To UBound(a) If Val(a(i, 3)) = Val(Class.Value) And a(i, 4) = Natija.Value Then k = k + 1 b(k) = a(i, 2) End If Next i If k > 0 Then ReDim Preserve b(1 To k): StudentName.List = b End If End Sub Private Sub UserForm_Initialize() Dim a Set ws = Worksheets("Sheet1") m = ws.Cells(Rows.Count, "B").End(xlUp).Row a = GetDistinct(ws.Range("D2:D" & m)) Natija.List = a a = GetDistinct(ws.Range("C2:C" & m)) Class.List = a End Sub Function GetDistinct(ByVal oTarget As Range) As Variant Dim vArr, v, dic As Object Set dic = CreateObject("Scripting.Dictionary") vArr = oTarget For Each v In vArr If Not IsEmpty(v) Then dic(v) = v Next v GetDistinct = dic.Items() End Function

الحلقة التكرارية تتوقف مع نهاية عدد كلمات المستند

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

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