شكرا اساتذتنا الكرام على تفاعلكم الجميل معنا
لا تقسو علينا فنحن تلامذتكم نعتذر عن اخطائنا فلولا الخطأ لما تعلمنا الصواب
فمعرفة الشي تكون اسهل بمعرفة نقيضه
وشكر ا للاستاذ ياسر خليل على نصائحه
لكنني رغم تطبيقي لارشاداتك لم اتوصل للغاية المنشودة
وبعد بحث طويل بلغات اجنبية توصلت لدالة وفت بالغرض وهي Intersect والتي تعني تقاطع خلية بنطاق او نطاق بنطاق
وهذا هو الكود الذي وفا بالغرض
thisworkbook :
CODE
Private Sub Workbook_Open()
Application.OnKey "{ENTER}", "jumpToNextColumn"
Application.OnKey "~", "jumpToNextColumn"
End Sub
Module :
CODE
Option Explicit
Sub jumpToNextColumn()
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
Dim rng10 As Range
Dim rng1p As Range
Dim rng2p As Range
Dim rng3p As Range
Dim rng4p As Range
Dim rng5p As Range
Dim rng6p As Range
Dim rng7p As Range
Dim rng8p As Range
Dim rng9p As Range
Dim rng10p As Range
Set rng2p = Range("b29")
Set rng3p = Range("b60")
Set rng4p = Range("b91")
Set rng5p = Range("b122")
Set rng6p = Range("b153")
Set rng7p = Range("b184")
Set rng8p = Range("b215")
Set rng9p = Range("b246")
Set rng10p = Range("b277")
Set rng1 = Range("b10:b28")
Set rng2 = Range("b41:b59")
Set rng3 = Range("b72:b90")
Set rng4 = Range("b103:b121")
Set rng5 = Range("b122:b152")
Set rng6 = Range("b165:b183")
Set rng7 = Range("b196:b214")
Set rng8 = Range("b227:b245")
Set rng9 = Range("b258:b276")
Set rng10 = Range("b289:b307")
'
If Not Intersect(ActiveCell, rng1) Is Nothing Then
ActiveCell.Offset(1, 3).Select
ElseIf Not Intersect(ActiveCell, rng2p) Is Nothing Then
ActiveCell.Offset(12, 3).Select
ElseIf Not Intersect(ActiveCell, rng2) Is Nothing Then
ActiveCell.Offset(1, 3).Select
ElseIf Not Intersect(ActiveCell, rng3p) Is Nothing Then
ActiveCell.Offset(12, 3).Select
ElseIf Not Intersect(ActiveCell, rng3) Is Nothing Then
ActiveCell.Offset(1, 3).Select
ElseIf Not Intersect(ActiveCell, rng4p) Is Nothing Then
ActiveCell.Offset(12, 3).Select
ElseIf Not Intersect(ActiveCell, rng4) Is Nothing Then
ActiveCell.Offset(1, 3).Select
ElseIf Not Intersect(ActiveCell, rng5p) Is Nothing Then
ActiveCell.Offset(12, 3).Select
ElseIf Not Intersect(ActiveCell, rng5) Is Nothing Then
ActiveCell.Offset(1, 3).Select
ElseIf Not Intersect(ActiveCell, rng6p) Is Nothing Then
ActiveCell.Offset(12, 3).Select
ElseIf Not Intersect(ActiveCell, rng6) Is Nothing Then
ActiveCell.Offset(1, 3).Select
ElseIf Not Intersect(ActiveCell, rng7p) Is Nothing Then
ActiveCell.Offset(12, 3).Select
ElseIf Not Intersect(ActiveCell, rng7) Is Nothing Then
ActiveCell.Offset(1, 3).Select
ElseIf Not Intersect(ActiveCell, rng8p) Is Nothing Then
ActiveCell.Offset(12, 3).Select
ElseIf Not Intersect(ActiveCell, rng8) Is Nothing Then
ActiveCell.Offset(1, 3).Select
ElseIf Not Intersect(ActiveCell, rng9p) Is Nothing Then
ActiveCell.Offset(12, 3).Select
ElseIf Not Intersect(ActiveCell, rng9) Is Nothing Then
ActiveCell.Offset(1, 3).Select
ElseIf Not Intersect(ActiveCell, rng10p) Is Nothing Then
ActiveCell.Offset(12, 3).Select
ElseIf Not Intersect(ActiveCell, rng10) Is Nothing Then
ActiveCell.Offset(1, 3).Select
ElseIf ActiveCell.Column = 3 Or 4 Then
ActiveCell.Offset(0, -1).Select
End If
End Sub
تعديل كود لادخال جملة شرطية فيه
تعديل كود لادخال جملة شرطية فيه
