كود لمنع ادخال اكثر من عدد معين من الحروف

[محمد مصطفى ابو حمزة]

كود لمنع ادخال اكثر من عدد معين من الحروف

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    For Each cell In UsedRange

'تدخل عدد الاحرف بعد علامة <

	    If Len(cell.Value) > 15 Then

		    MsgBox " عدد الاحرف اكثر من المسموح به __منتدى اوفيسنا___"

		    cell.Value = ""

	    End If

    Next

End Sub

[محمد مصطفى ابو حمزة]

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

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

	Dim rng As Range

	Dim rCell As Range

	Dim iChars As Integer

	On Error GoTo ErrHandler

   'Change these as desired

'لكتابة عدد الاحرف

	iChars = 15

'لكتابة المدى المراد استخدامه (منتدى اوفيسنا)

	Set rng = Me.Range("A1:A10")

	If Not Intersect(Target, rng) Is Nothing Then

		Application.EnableEvents = False

		For Each rCell In Intersect(Target, rng)

			If Len(rCell.Value) > iChars Then

				rCell.Value = Left(rCell.Value, iChars)

				MsgBox rCell.Address & " has more than" _

				  & iChars & " characters." & vbCrLf _

				  & "It has been truncated."

			End If

		Next

	End If

ExitHandler:

	Application.EnableEvents = True

	Set rCell = Nothing

	Set rng = Nothing

	Exit Sub

ErrHandler:

	MsgBox Err.Description

	Resume ExitHandler

End Sub

تم تعديل مارس 19, 2012 بواسطه محمد مصطفى.2011

[ابو تميم]

روعة أخي محمد مصطفى

بارك الله فيك

[محمد مصطفى ابو حمزة]

شكرا على ردك اخى وبارك الله لك

[الـعيدروس]

السلام عليكم

اكواد جميله اخ محمد مصطفى

جزاك الله الف خير

تقبل مروري

[محمد مصطفى ابو حمزة]

شكرا على الردود الجميلة بارك الله لكم