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

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

تفضل الاساسى.xlsm

حاضر يا صديقي ABO_AZ NEW.xlsx

عليكم السلام حسب فهمي لطلبك اضفت الى مثالك ثلاثة اسطر TreeView2.SelectedItem.BackColor = 255 TreeView2.SelectedItem.ForeColor = vbGreen Text1 = Node.Text وهذه طريقة اخرى لتلوين العقد Dim X As Integer X = TreeView2.SelectedItem.Index TreeView2.Nodes.Item(currindex + X).BackColor = vbBlue TreeView2.Nodes.Item(currindex + X).ForeColor = 255 DB3.mdb

وعليكم السلام انظر الصورة .... ادخل رقما مكان السهم بدلا من الرقم الموجود ثم انتقل بزر TAB ولاحظ الترقيم فردي.accdb

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

جرب هذا الملف مع خيار بداية الترقيم في الخلية D2 والتناقص في الخلية B2 ABO_AZ.xlsx

استبدال الكود بالتالي If IsNull(Me.XX) Then DoCmd.GoToControl "XX" MsgBox "ادخل قيمة اولاً" Else myCriteria = "[B]= " & Me.XX Me.Filter = myCriteria Me.FilterOn = True End If XX.rar تحياتي

قم بتعديل الكود للزر الجديد كالتالي If IsNull(Me.XX1) Or IsNull(Me.XX) Then DoCmd.GoToControl "XX1" MsgBox "XX1C IS EMPTY" Else myCriteria = "[B]= " & Me.XX myCriteria = myCriteria & " AND " myCriteria = myCriteria & "(" myCriteria = myCriteria & "[C]= " & Me.XX1 myCriteria = myCriteria & ")" Me.Filter = myCriteria Me.FilterOn = True End If XX1.rar تحياتي

فعلا الكود شغال وبيعمل جيدا

بارك الله بك اخي الفاضل استاذ الفلاحجي فهمت السؤال خطأ لاني كنت على عجلة من امري مهماً بالخروج واعتذر للاخ ameer.iraq.93

شكر وتقدير واحترام من اخيك استاذنا ربنا يحفظك يارب

تم تصحيح الاخطاء Reservation Form (111) (1).xlsm

بعد اذن أخي الرائد هذا الكود في نفس الصفحة ("البيانات") حدد كم صفاً تريد للطباعة على ورقة واحدة من الخلية H1 و اضغط الزر ثم اذهب الى معاينة قبل الطباعة لتجد المطلوب Option Explicit Sub Page_Break() Dim B As Worksheet Dim LA%, x%, Ho_many% Dim Rg_a As Range Set B = Sheets("البيانات") If Val(B.Range("H1")) <= 4 Then Ho_many = 4 Else Ho_many = Int(B.Range("H1")) End If B.Range("h1") = Ho_many LA = B.Range("A1").CurrentRegion.Rows.Count ActiveSheet.ResetAllPageBreaks For x = Ho_many + 6 To LA Step Ho_many B.HPageBreaks.Add Before:=B.Range("A" & x) Next End Sub الملف مرفق Insert_H_Breaks.xlsm

تفضل ترحيل بيانات جدول.xlsx

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

تفضل . طباعة الجميع بنقرة واجدة . انشىء مجلد باسم raed على القرص c اختر طباعة من مثلا : 101 االى 106 . من الخلية e1 الى c1 . اكتب من الرقم الذي تريد الى الرقم الذي تريد عند انشاء الملفات و تريد اعادة انشاءها مرة ثانية . قم بمسح الملفات من المجلد raed و اعد تشغيل الماكرو تجد جميع الملفات pdf في المجلد و اسم كل ملف هو كود الطالب Sub svPDF() Dim i As Integer For i = Range("e1") To Range("c1") Range("d3").Value = i Dim expfd As String expfd = "C:\raed\" & Range("d3").Value & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=expfd, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True Next i End Sub Student Plan.xlsm

لا حاجة للكود اضغط سهم يمين أو يسار تنتقل الى حيثما تريد

معادلة اخرى (معقدة قليلاَ) في العامود I تقوم ابضاَ بالمطلوب ABO_AZ NEW_2.xlsx

تم التعديل على المعادلات جسب ما تريد ABO_AZ NEW_1.xlsx

انا اسف جدا كنت اقصد العكس تحتاج فقط الى استخدام Sum بدلا من Group By كما بالصور تحياتي

بارك الله فيك أخي شحادة ما قصرت ربنا يزيدك من فضله، وينفع بك الإسلام والمسلمين اللهم آمين تمنياتنا لكم دوماً بالتوفيق والسداد

وعليكم السلام اخي في المرة القادمة ارفق مثال بسيط ليتسنى للاخوة مساعدتك وليتم التعديل على المثال المرفق ويقولون لك ( تفضل ) ضع هذا الكود في (عند عدم الوجود في القائمة) من القائمة المنسدلة 'downloaded from A-Soft Channel on youtube On Error GoTo myError: Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("اسم الجدول الفرعي", dbOpenDynaset) If vbYes = MsgBox("هذا الفرع الذي اظفته جديد ليس من ضمن القائمة . هل تريد اظافته الى القائمة " _ & NewData & " ", _ vbYesNoCancel + vbDefaultButton2, _ "New اسم مصدر عنصر التحكم في الجدول الاساسي") Then rst.AddNew rst!اسم العمود في الجدول الفرعي = NewData rst.Update Response = acDataErrAdded Else Response = acDataErrContinue Me.اسم القائمة المنسدلة = Null End If leave: If Not rst Is Nothing Then rst.Close: Set rst = Nothing End If Exit Sub myError: MsgBox "Error " & Err.Number & ": " & Error$ Resume leave

اسعد الله صباحك استاذنا العزيز husamwahab واشكرك جزيل الشكر هو المطلوب تماما

تفضل استاذي العزيز ارجو ان يكون طلبك DB2.rar

اذا كنت تقصد هذا تفضل هذا التعديل عشوائى.rar تحياتي

بالتوفيق اخي الكريم تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم myCriteria = "[B]= " & Me.XX Me.Filter = myCriteria Me.FilterOn = True XX.rar تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Dim fpath As Variant Dim fpathz As Variant With Application.FileDialog(3) .Title = "Choose File" .Filters.Clear .Filters.Clear .Filters.Add "All Files", "*.*" .InitialFileName = "Z:\" & Me.X1.Column(1) & "\" .AllowMultiSelect = False .InitialFileName = "" If .Show = -1 Then fpathz = .SelectedItems(1) End If End With ffff.rar تحياتي

الله يبارك في عمرك وعملك، وفقكم الله دوماً للخير، وإن شاء الله يكون هذا العمل في ميزان حسناتكم أخي الحبيب. إضافات رائعة، تُيسِّر على الباحث الكثير الكثير من الجهد والوقت. وإلى الأمام تمنياتنا لكم دوماً بالتوفيق والسداد

عند عمل طريقه لا اعرف لماذا يظهر خطأ

الحمد لله الذي بنعمته تتم الصالحات

شوف بنفسك فربما تكون المشكلة لديك انت ... فملف الأستاذ علي كما ترى يعمل بكل كفاءة

السلام عليكم ورحمة الله ضع هذه المعادلة فى الخلية "G4" اولا ثم اسحب نزولا =LARGE($C$3:$C$50;$E4) ثم ضع المعادلة التالية فى الخلية "F4" ثم اسحب نزولا و لا تنسى الضغط على CRTL+SHIFT+ENTER =IFERROR(INDEX($B$3:$C$50;SMALL(IF($C$3:$C$50=$G4;ROW($C$3:$C$50));ROW($A$1))-2;1);"")

تفضل أحمد فرج1.xls

بالنسبة للبحث تم عمل باليوزر فورم تيكست بوكس يتم كتابه والبحث كما موضح بالصوره اعلاه وليست بوكس يظهر به النتائج بالاضافة انه يمكن الضغط على اى من نتائج البحث يتم التعبئة التلقائية بالتيكست بوكسات الخاصة بهم لامكانية الحذف والتعديل فى نفس الوقت اظن هذا طلبك مع ملاحظة الكتابة داخل تيكست بوكس باللغة العربية userform4 (2).xlsm

تم عمل زر بحث للبحث باول حرف يتم عمل تصفيه اتمنى يكون ساعدك شكرا Private Sub TextBox1_Change() If TextBox1 <> "" Then lr = Range("B" & Rows.Count).End(xlUp).Row ActiveSheet.Range("$A$2:$F$" & lr).AutoFilter field:=2, Criteria1:="=" & ActiveSheet.TextBox1.Text & "*" Else Range("A2").AutoFilter End If End Sub userform4 (1).xlsm

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

بعد اذن الأخ أمين هذا الملف adelalmalki.xlsm

تفضل جرب هدا تواتي29).xlsm

وعليكم السلام ورحمة الله وبركاته عن طريق تسجيل ماكرو جرب الملف بالضغط على الزر تواتي29).xlsm

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