logo

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
noureddine70 لا تميز خلال هذه الفترة-- لا تميز خلال هذه الفترة YasserKhalil برنامج فك حماية محرر الأكواد VBA وحماية unviewable اكسيل اسئله واجابات



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





04-02-2020 06:38 مساءً
هل ممكن ان تتكرم بتطوير هذا الكود
والمراد
هو ان يشتغل زر انتر بشكل طبيعي الى اذا كانت الخلية الاكتيف توجد في نطاقات معينة من العمود B
مثلا Active Cell = احد الخلايا من النطاقات التالية ("B10:B28) و ("B41:B59) و("B72:B90)
ولك جزيل الشكر

عندما نعتبر المتغير i يساوي رقم السطر

يظهر خطأ عند تنفيذ الامر



فما هي المشكلة من فضلكم
==>ThisWorkbook :

CODE


Private Sub Workbook_Open()
    Application.OnKey "{ENTER}", "jumpToNextColumn"
    Application.OnKey "~", "jumpToNextColumn"
End Sub


==>Module :
CODE

Option Explicit

Sub jumpToNextColumn()
Dim i As Variant
Dim j As Variant
Dim k As Variant

For i = 10 To 28
For j = 41 To 59
For k = 72 To 90
' i = رقم السطر
' j = رقم السطر
' k = رقم السطر
If ActiveCell = Range(i, "b") Then
ActiveCell.Offset(i + 1, "d").Select
ElseIf ActiveCell = Range(j, "b") Then
ActiveCell.Offset(j + 1, "d").Select
ElseIf ActiveCell = Range(k, "b") Then
ActiveCell.Offset(k + 1, "d").Select
End If
Next
Next
Next
End Sub

من فضلك لا تكرر نفس المشاركات والا ستحذف جميع المشاركات
 
  jumpToNextColumn3.png   تحميل png jumpToNextColumn3.png مرات التحميل :(2)
الحجم :(68.538) KB
 




توقيع :جنان السبيل
[p]
يتم اكتساب المعرفة من خلال التجربة ، كل شيء آخر هو مجرد معلومات.
البرت اينشتاين

زكاة العلم نشره
</pre>

look/images/icons/i1.gif تعديل كود لادخال جملة شرطية فيه
  03-02-2020 08:35 مساءً   [1]
معلومات الكاتب ▼
تاريخ الإنضمام : 14-01-2020
رقم العضوية : 17616
المشاركات : 63
الجنس :
تاريخ الميلاد : 1-1-1996
قوة السمعة : 146
الاعجاب : 0
مطلوب تعديل كود لادخال جملة شرطية فيه
الكود مهمته التنقل من خلايا بالعمود B الى خلايا بالعمود D
الجملة الشرطية هي اذا كانت الخلية الاكتيف توجد في العمود B وضغطنا على زر انتر ننقل الى الخلية في السطر المولي الى العمودD

وهذا هو الكود الذي توصلت اليه لكنه يعمل في الشيت كامل
CODE
Private Sub Workbook_Open()
    Application.OnKey "{ENTER}", "jumpToNextColumn"
    Application.OnKey "~", "jumpToNextColumn"
End Sub

Sub jumpToNextColumn()
ActiveCell.Offset(1, 3).Select
End Sub

والكود المراد التوصل اليه
CODE
Sub jumpToNextColumn()
If Target.Column = B Then ActiveCell.Offset(1, 3).Select
End Sub

من فضلك دائما وابدا يتم التنبيه على وضع الأكواد فى المكان المخصص لها حتى تظهر بالشكل السليم



توقيع :جنان السبيل
[p]
يتم اكتساب المعرفة من خلال التجربة ، كل شيء آخر هو مجرد معلومات.
البرت اينشتاين

زكاة العلم نشره
</pre>

look/images/icons/i1.gif تعديل كود لادخال جملة شرطية فيه
  03-02-2020 10:52 مساءً   [2]
معلومات الكاتب ▼
تاريخ الإنضمام : 14-01-2020
رقم العضوية : 17616
المشاركات : 63
الجنس :
تاريخ الميلاد : 1-1-1996
قوة السمعة : 146
الاعجاب : 0
لقد توصلت للكود بعد عناء البحث بالفرنسية والانجليزية
وبعد عدة تجارب وها هو الكود لتعم الفائدة والكود يعني ان يشتغل زر انتر بشكل طبيعي الى اذا كانت الخلية الاكتيف توتجد في العمود B


==>ThisWorkbook :

CODE
Private Sub Workbook_Open()
    Application.OnKey "{ENTER}", "jumpToNextColumn"
    Application.OnKey "~", "jumpToNextColumn"
End Sub

==>Module :
CODE
Option Explicit
Sub jumpToNextColumn()
 If ActiveCell.Column = 2 Then
 ActiveCell.Offset(1, 3).Select
 Else
 ActiveCell.Offset(0, -1).Select
 End If
End Sub



توقيع :جنان السبيل
[p]
يتم اكتساب المعرفة من خلال التجربة ، كل شيء آخر هو مجرد معلومات.
البرت اينشتاين

زكاة العلم نشره
</pre>

look/images/icons/i1.gif تعديل كود لادخال جملة شرطية فيه
  03-02-2020 11:23 مساءً   [3]
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 47
المشاركات : 819
الجنس :
تاريخ الميلاد : 14-10-1973
الدعوات : 79
قوة السمعة : 8466
الاعجاب : 11
بارك الله فيك / جنان السبيل
ولتعم الفائدة أكثر قم بوضع الأكواد المدرجة بالمشاركات فى الكود بالشكل الصحيح
وهو نسخ الكود المراد مشاركته ثم الضغط على أيقونة ( إدراج كود ) من أدوات التنسيق بالأعلى
ثم قم بلصق الكود
ليكون بالشكل التالى فى المشاركات
=>ThisWorkbook :

CODE
Private Sub Workbook_Open()
    Application.OnKey "{ENTER}", "jumpToNextColumn"
    Application.OnKey "~", "jumpToNextColumn"
End Sub


والكود التالى
Module
CODE
Sub jumpToNextColumn()
 If ActiveCell.Column = 2 Then
 ActiveCell.Offset(1, 3).Select
 Else
 ActiveCell.Offset(0, -1).Select
 End If
End Sub





look/images/icons/upload/awt9.gif تعديل كود لادخال جملة شرطية فيه
  04-02-2020 12:12 صباحاً   [4]
معلومات الكاتب ▼
تاريخ الإنضمام : 14-01-2020
رقم العضوية : 17616
المشاركات : 63
الجنس :
تاريخ الميلاد : 1-1-1996
قوة السمعة : 146
الاعجاب : 0
جزاك الله كل خير استاذنا محمد الدسوقى</b>
على الارشادات
اعتذر على الخطأ الغير متعمد

هل ممكن ان تتكرم بتطوير هذا الكود
والمراد
هو ان يشتغل زر انتر بشكل طبيعي الى اذا كانت الخلية الاكتيف توجد في نطاقات معينة من العمود B
مثلا Active Cell = احد الخلايا من النطاقات التالية ("B10:B28) و ("B41:B59) و("B72:B90)
ولك جزيل الشكر

عندما نعتبر المتغير i يساوي رقم السطر
و i تساوي 10 الى 28
يظهر خطأ عند تنفيذ الامر



فما هي المشكلة من فضلكم
 
  jumpToNextColumn.png   تحميل png jumpToNextColumn.png مرات التحميل :(0)
الحجم :(33.854) KB
  jumpToNextColumn2.png   تحميل png jumpToNextColumn2.png مرات التحميل :(0)
الحجم :(36.108) KB
 




توقيع :جنان السبيل
[p]
يتم اكتساب المعرفة من خلال التجربة ، كل شيء آخر هو مجرد معلومات.
البرت اينشتاين

زكاة العلم نشره
</pre>

look/images/icons/i1.gif تعديل كود لادخال جملة شرطية فيه
  04-02-2020 09:13 مساءً   [5]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10525
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36745
الاعجاب : 182
استخدم Cells بدلاً من Range حيث يتبع كلمة Cells رقم الصف وهو في هذه الحالة المتغير i ورقم العمود هو 2 بما أنه هو العمود B
أو يمكن استخدام Range ولكن تشير إلى العمود أولاً ثم تستخدم علامة & ثم تشير لرقم الصف وهو المتغير i
CODE
Range(&quot;B&quot; &amp; i)




look/images/icons/i1.gif تعديل كود لادخال جملة شرطية فيه
  05-02-2020 05:02 صباحاً   [6]
معلومات الكاتب ▼
تاريخ الإنضمام : 14-01-2020
رقم العضوية : 17616
المشاركات : 63
الجنس :
تاريخ الميلاد : 1-1-1996
قوة السمعة : 146
الاعجاب : 0
شكرا اساتذتنا الكرام على تفاعلكم الجميل معنا
لا تقسو علينا فنحن تلامذتكم نعتذر عن اخطائنا فلولا الخطأ لما تعلمنا الصواب
فمعرفة الشي تكون اسهل بمعرفة نقيضه

وشكر ا للاستاذ ياسر خليل على نصائحه
لكنني رغم تطبيقي لارشاداتك لم اتوصل للغاية المنشودة
وبعد بحث طويل بلغات اجنبية توصلت لدالة وفت بالغرض وهي 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




توقيع :جنان السبيل
[p]
يتم اكتساب المعرفة من خلال التجربة ، كل شيء آخر هو مجرد معلومات.
البرت اينشتاين

زكاة العلم نشره
</pre>

اضافة رد جديد اضافة موضوع جديد



المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
اكواد لادخال بيانات وتعديلها محمد9009
8 1756 مهند محسن
فورم ادخال البيانات والتأكد منها للادخال مجدى يونس
2 1878 مجدى يونس
طلب تصحيح كود الادخال krimo145
12 1683 krimo145
عدم تعديل التاريخ بعد الادخال khaled alborene
5 1316 YasserKhalil
عمل فورم الادخال في اكسل بتفاصيل رائعة مع الاستاذ الرائع اسلام رجب Ahmed Samir
1 2833 Ahmed Samir

الكلمات الدلالية
مطلوب ، تعديل ، لادخال ، جملة ، شرطية ،









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

الساعة الآن 06:20 AM