abouelhassan

شكر وتقدير واحترام من اخيك

اخى الكريم توقف الكود عند اختيار تغير كلمة المرور ' عند النقر على زر تغيير كلمة المرور Private Sub btn_changeclick_Click() On Error Resume Next ' إخفاء رسالة الخطأ في البداية Me.Lbl_incorrect.Visible = False ' التحقق من اختيار المستخدم If IsNull(Form_Movie_pag.txt_username) Or Form_Movie_pag.txt_username = "" Then Me.Lbl_incorrect4.Caption = "تحذير" Me.Lbl_incorrect3.Caption = "الرجاء اختيار المستخدم" Me.Lbl_incorrect4.Visible = True Me.Lbl_incorrect3.Visible = True Form_Movie_pag.txt_username.SetFocus Exit Sub

شكر وتقدير واحترام من اخيك

شكر وتقدير واحترام من اخيك

شفاه الله وعفاه وألبسه لباس الصحه والعافيه ان شاء الله

شكر وتقدير واحترام من اخيك

الف شكر اخى الكريم وكل عام وانتم بخير وصحة عندما اضفت الكود للبرنامج لدى توقف الكود هنا lRow = ActiveCell.SpecialCells(xlLastCell).Row

احتاج تعديل بلكود اخى يعمل من d2 وينفذ التعديل فى نفس العمود لا ينقل المعدل فf كل عام وانتم بخير وصحه وسلامه اشكرك اخي الكريم الحبيب

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

اخى فى الله حسونة حسين بارك الله فيك اخى الكود حول الارقام التى تحوى فاصلة الى 0 لم ينجح فى تحويلها الى رقم صحيح القرأة كرقم ده انا سجلت ماكرو بالاستبدال وبردو لم تنجح مش عارف السبب مشكووور

انا بعمل كده اخى في الله وكمان بحول النص الى نمبر احتاج الكود لا ستدعيه من كود أخر فى برنامج وبالتالى يكون عمود الأرقام بعد استدعاؤه جاهز مشكور اخي

شكرا لك هذا غير مطلوب اخى

جرب لعله يكون مفيدا Private Sub Worksheet_Change(ByVal Target As Range) Dim ch As Variant Dim cell As Range ' تحقق إذا كانت التغييرات داخل النطاق المطلوب If Not Intersect(Target, Me.Range("E10:E1009")) Is Nothing Then Application.EnableEvents = False Application.ScreenUpdating = False ' ضبط الأسماء وإزالة المسافات الزائدة لكل خلية تم تغييرها For Each cell In Intersect(Target, Me.Range("E10:E1009")) ' ضبط الأسماء قبل عملية الأبجدة For Each ch In Array("إ", "أ", "آ") cell.Value = Replace(cell.Value, CStr(ch), "ا", 1, -1, vbTextCompare) Next cell.Value = Replace(cell.Value, "ة", "ه", 1, -1, vbTextCompare) cell.Value = Replace(cell.Value, "ي ", "ى ", 1, -1, vbTextCompare) ' إزالة المسافات الزائدة Do While InStr(cell.Value, " ") > 0 cell.Value = Replace(cell.Value, " ", " ") Loop cell.Value = Trim(cell.Value) Next cell Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub

جرب لعله يكون مفيدا Private Sub Worksheet_Change(ByVal Target As Range) ' تحقق إذا كانت التغييرات داخل النطاق المطلوب If Not Intersect(Target, Me.Range("E10:E1009")) Is Nothing Then ' ضبط الأسماء قبل عملية الأبجدة Dim ch As Variant Application.ScreenUpdating = False With Me.Range("E10:E1009") For Each ch In Array("إ", "أ", "آ") .Replace CStr(ch), "ا", , , True Next .Replace "ة", "ه", , , True .Replace "ي ", "ى ", , , True End With ' إزالة المسافات الزائدة Dim lr As Long, i As Long lr = Me.Cells(Me.Rows.Count, 5).End(xlUp).Row For i = 10 To lr Do While InStr(Me.Cells(i, 5), " ") > 0 Me.Cells(i, 5).Value = Replace(Me.Cells(i, 5), " ", " ") Loop Me.Cells(i, 5).Value = Trim(Me.Cells(i, 5).Value) Next i Application.ScreenUpdating = True End If End Sub

جرب لعله يفيدك Sub Names_Adjust() ' ضبط الأسماء قبل عملية الأبجدة ' -------------------------- Dim ch Application.ScreenUpdating = False With Range("E10:E1009") For Each ch In Array("إ", "أ", "آ") .Replace CStr(ch), "ا", , , True Next .Replace "ة", "ه", , , True .Replace "ي ", "ى ", , , True End With ' إزالة المسافات الزائدة Dim sh As Worksheet, lr As Long, i As Long Set sh = ThisWorkbook.ActiveSheet lr = sh.Cells(Rows.Count, 5).End(xlUp).Row For i = 10 To lr Do While InStr(sh.Cells(i, 5), " ") > 0 sh.Cells(i, 5).Value = Replace(sh.Cells(i, 5), " ", " ") Loop sh.Cells(i, 5).Value = Trim(sh.Cells(i, 5).Value) Next i Application.ScreenUpdating = True End Sub