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

السلام عليكم تستعمل هذا الكود خلف زر البحث If IsNull(Me.iSearch) Then Me.FilterOn = False Me.iSearch.SetFocus Else Me.Filter = Nz(Me.fild_search, "IDfoaid") & "='" & Me.iSearch & "'" Me.FilterOn = True End If و هذا التعديل على الملف عمل كمبوبوكس لأختيار حقل البحث.rar

اذا نأتي على هواه ورغبته ولا نرتبط برقم محدد وتعديل على فكرتك Replace([mobile number];Right([Mobile Number];4);"0" & Right([Mobile Number];4);1;1) ما شاء الله حلول جاءت تباعا شكرا للاستاذ شيفان كنا نقرأ من كتاب واحد

شكرا لك استاذ @أبو إبراهيم الغامدي شكرا لك استاذ @ابوخليل اتفضل اليك هذا السطر من الاستعلام التحديث هذا هو الحل اذا كان طول البيانات ليس محددا UPDATE BASIC_DATE SET BASIC_DATE.crn = Replace([crn],Right([crn],4),"0" & Right([crn],4)); لكن انتبه يجب ان تشتغل استعلام التحديث مرة واحدة ولا اكثر والا ستضيفه اكثر من مرة تحديث - Copy.rar

مرحبا بك أستاذ أبو خليل على الرحب والسعة.. نعم.. وما أحسنه من حل؛ لو كان طول البيانات ثابت لكن أتوقع أن الأمر على خلاف ذلك..

مشاركة مع استاذنا ابو ابراهيم فيما لو اردنا المرونة وعدم التقيد برقم محدد او مكان محدد Left([Mobile Number];7) & "0" & Right([Mobile Number];4) هذا ينطبق على الارقام المطروحة هنا وعددها 11 فاقتطعنا 7 من اليسار و 4 من اليمين ثم وضعنا الصفر بينها

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

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

جرب هذا الملف الكود Option Explicit Sub copy_column() Dim Message1, Message2 Dim Rg2 As Range Dim arr() Dim Answer%, i%, LastCol% Message1 = Application.InputBox("Give range to Copy", Type:=8) Message2 = Application.InputBox("Give the column's Number in Sheet2", Type:=1) Set Rg2 = Sheets("sheet2").Columns(Message2) '================================ For i = LBound(Message1, 1) To UBound(Message1, 1) ReDim Preserve arr(1 To i) arr(i) = Message1(i, 1) Next '=================================== If Application.CountA(Rg2) > 0 Then Answer = MsgBox("the destination range is not empty" & Chr(10) & " do you want to OverWrite" _ , vbYesNoCancel) If Answer = 2 Then GoTo 1 If Answer = 6 Then Rg2.Delete Sheets("sheet2").Cells(1, Message2).Resize(UBound(arr) - LBound(arr) + 1, 1) = _ Application.Transpose(arr) Else LastCol = Sheets("sheet2").Cells(1, Columns.Count).End(1).Column Sheets("sheet2").Cells(1, Message2).Offset(0, LastCol).Resize(UBound(arr) - LBound(arr) + 1, 1) = _ Application.Transpose(arr) End If Erase arr Exit Sub End If Sheets("sheet2").Cells(1, Message2).Resize(UBound(arr) - LBound(arr) + 1, 1) = _ Application.Transpose(arr) 1: Erase arr End Sub الملف مرفق CopY_column.rar

اخی العزیز .. اھلا بک فی منتداک لكي لا يطول الامر ولا تنتظر كثير ارفق نسخة مصغرة من قاعدة بياناتك ووضح ماتريد بالتفصيل لكي نعمل لك التعديل المناسب عيد مبارك

تسنطيع اجراء اي تنسيق على اي خلية(او محموعة خلايا) شرط الا يحتوي النطاق على معادلات

استبدل اول 4 أسطر من الكود الى هذا الاسطر الاربعة (يوضع في حدث Thisworkbook وليس في موديل مستقل) Option Explicit Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Application.EnableEvents = False With ActiveSheet

على كل حال Replace تعيد البيانات بطولها بعد التعديل ولا حاجة إلى Left و Right معها لكن، ومع هذا: كل حل ممكن سيكون جميلا وهو محل اعتبار

قاعدة البيانات لا تعمل.. حالو رفعها من جديد.. هذا المرفق 2003 InsertMissingNumber.zip

استخدم دالة DlookUp لجلب حقل الاجمالي من الاستعلام

غير في خصائص التقرير "تفصيل" الى كما مبينة في الصورة

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

هذا الكود يمنع التعديل في الخلايا الني تحتوي على معادلات اذا اضفت اي معادلة الى الصفحة في اي خلية يطبق عليها الكود الكود (يوضع في جدث الصفحة المعنية وليس في موديل مستقل) Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.EnableEvents = False With Me .Unprotect .Cells.Locked = False With .Cells.SpecialCells(-4123, 23) .Locked = True .FormulaHidden = True End With .Protect End With Application.EnableEvents = True End Sub الملف مرفق Protect_Formula.rar

هل تريد هذا ؟ القي نظرتا الى الصورة اذا نعم ... اليكي الجواب اولا : تم تغيير الحقل Date من نوع النصی الێ نوع تاریخ والوقت ثانيا : تم استعلام q1 لکی نحصل على الرقم اي دي و اسم الموظف و اضغر تاريخ للموظف وهذه الاستعلام الاول SELECT persons.ID, persons.EmpName, Min(enterans_absent.Date) AS MinOfdate FROM persons INNER JOIN enterans_absent ON persons.ID = enterans_absent.IDb GROUP BY persons.ID, persons.EmpName; ثالثا : بواسطة الاستعلام الاولى عملنا استعلام ثاني باسم q2 ويعطيك النتيجة كما مبينة في صورة الاعلاه وهذه الاستعلام الثاني SELECT Q1.*, enterans_absent.* FROM Q1 INNER JOIN enterans_absent ON (Q1.MinOfdate = enterans_absent.date) AND (Q1.ID = enterans_absent.IDb); ملاحظة : في نهاية المطاف هناك احتمال ان يكون هناك مشاكل امامك لانكي تستعمل الاسماء المحجوزة مثل Date اليك القاعدة بعد تعديل new work.rar

السلام عليكم أخي الكريم بدايةً أهلاً بك في المنتدى ونورت بين إخوانك ثانياً عند طرح موضوع يجب إرفاق الملف في المنتدى وليس على رابط خارجي ثالثاُ الملف المرفق في الرابط الخارجي ملف محبط واعذرني لصراحتي .. حيث وجدت حجم الملف كبير جداً حوالي (11.7 ميجا) ، فاعتقدت في البداية أن هناك أوراق عمل أخرى أو أوراق عمل مخفية ، ولكني فوجئت بورقة عمل واحدة فقلت لابد أن هناك صفوف أو أعمدة مخفية وبها بيانات ولكن وجدت فقط النطاق المستخدم إلى الصف رقم 21 ... فعملت أن هناك تنسيقات غير ضرورية وبالفعل وجدت أن الجدول الأول على سبيل المثال ممتد لآخر صف وهذا أمر مهلك وهو ما جعل الملف بهذا الحجم .. فكان لابد من حذف الصفوف الغير ضرورية في الجدول عن طريق تحديد صفوف الجدول بدايةً من الصف رقم 22 إلى آخر الصفوف ثم حذفها .. لابد أن تقوم بذلك بنفسك .. المهم قم بوضع الكود التالي في حدث الفورم وجرب بنفسك Private Sub CommandButton1_Click() Dim ws As Worksheet Dim xf As Variant Dim lr As Integer Set ws = Sheets("ss") If Me.TextBox1.Value = "" Then MsgBox "Please Enter Name": Exit Sub If Me.TextBox2.Value = "" Then MsgBox "Please Enter Salary": Exit Sub If Me.ComboBox1.Value = "" Then MsgBox "Please Enter Statement": Exit Sub xf = Application.Match(ComboBox1.Value, ws.Rows(1), 0) If IsNumeric(xf) Then lr = ws.Cells(21, xf).End(xlUp).Row If lr = 2 Then MsgBox "This Is The Last Row", vbExclamation: Exit Sub ws.Cells(lr + 1, xf).Value = TextBox1.Value ws.Cells(lr + 1, xf + 1).Value = TextBox2.Value Call Reset_UserForm_Controls End If End Sub Private Sub CommandButton2_Click() Unload Me End Sub Sub Reset_UserForm_Controls() Dim c As Control For Each c In Me.Controls Select Case TypeName(c) Case "TextBox" c.Text = vbNullString Case "ListBox", "ComboBox" c.ListIndex = -1 End Select Next c TextBox1.SetFocus End Sub