اذهب الي المحتوي
أوفيسنا

مساعدة في كود تبديل رقم بنص


إذهب إلى أفضل إجابة Solved by محمد الورفلي1,

الردود الموصى بها

السلام عليكم

 

ممكن تحدي عمل هذا الكود في العمود c  فقط من c18:c2014

 

مع العلم هذا الكود يعمل بشكل ممتاز في جميع الخلاية ولكن اريدة فقط في العمود c

 

كود تبديل رقم بنص.rar

رابط هذا التعليق
شارك

تفضل أخي الحبيب :

Private Sub Worksheet_Change(ByVal Target As Range)
    
    
If Not Intersect(Target, Range("C18:C2014")) Is Nothing Then
        Select Case Target
            Case 1
                Target = "اولي ابتدائي"
            Case 2
                Target = "ثانية ابتدائي"
            Case 3
                Target = "ثالثة ابتدائي"
            Case 4
                Target = "الصف الرابع"
            Case 5
                Target = "الصف الخامس"
            Case 6
                Target = "الصف السادس"
            Case 7
                Target = "الصف السابع"
            Case 8
                Target = "الصف الثامن"
            Case 9
                Target = "الصف التاسع"

        End Select
    End If
    
End Sub

رابط هذا التعليق
شارك

الاخ ياسر شكراً

 

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

Private Sub Worksheet_Change(ByVal Target As Range)
    
If Not Intersect(Target, Range("C18:C2014")) Is Nothing Then
        Select Case Target
            Case 1
                Target = "اولي ابتدائي"
            Case 2
                Target = "ثانية ابتدائي"
            Case 3
                Target = "ثالثة ابتدائي"
            Case 4
                Target = "الصف الرابع"
            Case 5
                Target = "الصف الخامس"
            Case 6
                Target = "الصف السادس"
            Case 7
                Target = "الصف السابع"
            Case 8
                Target = "الصف الثامن"
            Case 9
                Target = "الصف التاسع"

        End Select
    End If
    
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Column = 4 Or Target.Column > 8 Then GoTo 1
lr = Cells(Rows.Count, 2).End(xlUp).Row
If Range("B" & lr) = "" Or Range("C" & lr) = "" Or Range("d" & lr) = "" _
Or Range("e" & lr) = "" Then GoTo 1

    Range("b18:e" & lr).Select
    Selection.Sort Key1:=Range("b18"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
'''''''''''''''''''''''''''''''''''''''''''''''
       With Range("b20:b" & lr + 3)
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Font.Size = 18
      .Font.Bold = True
      End With
     
''''''''''''''''''''''''''''''''''''''''''''
      With Range("b20:b" & lr + 3)
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Font.Size = 18
      .Font.Bold = True
      End With
      Range("b" & lr + 5).Select
1:
Application.ScreenUpdating = True
End Sub




رابط هذا التعليق
شارك

تم حل المشكلة للفائدة

Private Sub Worksheet_Change(ByVal Target As Range)
    
If Not Intersect(Target, Range("C18:C2014")) Is Nothing Then
        Select Case Target
            Case 1
                Target = "اولي ابتدائي"
            Case 2
                Target = "ثانية ابتدائي"
            Case 3
                Target = "ثالثة ابتدائي"
            Case 4
                Target = "الصف الرابع"
            Case 5
                Target = "الصف الخامس"
            Case 6
                Target = "الصف السادس"
            Case 7
                Target = "الصف السابع"
            Case 8
                Target = "الصف الثامن"
            Case 9
                Target = "الصف التاسع"

        End Select
    End If
    
Application.ScreenUpdating = False
If Target.Column = 4 Or Target.Column > 8 Then GoTo 1
lr = Cells(Rows.Count, 2).End(xlUp).Row
If Range("B" & lr) = "" Or Range("C" & lr) = "" Or Range("d" & lr) = "" _
Or Range("e" & lr) = "" Then GoTo 1

    Range("b18:e" & lr).Select
    Selection.Sort Key1:=Range("b18"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
'''''''''''''''''''''''''''''''''''''''''''''''
       With Range("b20:b" & lr + 3)
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Font.Size = 18
      .Font.Bold = True
      End With
     
''''''''''''''''''''''''''''''''''''''''''''
      With Range("b20:b" & lr + 3)
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Font.Size = 18
      .Font.Bold = True
      End With
      Range("b" & lr + 5).Select
1:
Application.ScreenUpdating = True
End Sub

تم تعديل بواسطه محمد الخازمي
رابط هذا التعليق
شارك

  • أفضل إجابة

السلام عليكم

 

الاخ الكريم ياسر

 

 

الملف لم يكتمل بعد ارجو تصحيح ما تجده من اخطاء

هذا الكود تعبو فيه الاساتذة في المنتدي معي حتي ظهر بهذ الشكل

 

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

                  2/ كود وضع حرف ((  ك  )) في خلية  ترمز الي  ((  ذكر  ))) و حرف ( ن ) الي انثى

                  3/ كود ابجدة تلقائي والا نتقال الي اخر خلية فارغة عند وضع اسم الطالب

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C18:C2014")) Is Nothing Then
        Select Case Target
            Case 1
                Target = "اولي ابتدائي"
            Case 2
                Target = "ثانية ابتدائي"
            Case 3
                Target = "ثالثة ابتدائي"
            Case 4
                Target = "الصف الرابع"
            Case 5
                Target = "الصف الخامس"
            Case 6
                Target = "الصف السادس"
            Case 7
                Target = "الصف السابع"
            Case 8
                Target = "الصف الثامن"
            Case 9
                Target = "الصف التاسع"

        End Select
    End If
    If Not Intersect(Target, Range("d18:d2014")) Is Nothing Then
        Select Case Target
            Case "ك"
                Target = "ذكر"
            Case "ن"
                Target = "انثى"
            

        End Select
    End If


Application.ScreenUpdating = False
If Target.Column = 4 Or Target.Column > 8 Then GoTo 1
lr = Cells(Rows.Count, 2).End(xlUp).Row
If Range("B" & lr) = "" Or Range("C" & lr) = "" Or Range("d" & lr) = "" _
Or Range("e" & lr) = "" Then GoTo 1

    Range("b18:e" & lr).Select
    Selection.Sort Key1:=Range("b18"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
'''''''''''''''''''''''''''''''''''''''''''''''
       With Range("b20:b" & lr + 3)
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Font.Size = 18
      .Font.Bold = True
      End With
     
''''''''''''''''''''''''''''''''''''''''''''
      With Range("b20:b" & lr + 3)
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Font.Size = 18
      .Font.Bold = True
      End With
      Range("b" & lr + 5).Select
1:
Application.ScreenUpdating = True
End Sub




شئون بسيط.rar

تم تعديل بواسطه محمد الخازمي
رابط هذا التعليق
شارك

الأخ محمد الحبيب

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

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information