تنفيذ التعليمات البرمجية الموجودة في زر command عند الضغط على خلية لمدة معينة

[محمود1980]

الاخوة الاعزاء 

بعد التحية 

 

اذا كان عندي زر command وفيه تعليمات معينة ، فهل ممكن اذا قمت بالنقر على اي خلية في العمود b مثلا  تنفيذ التعليمات الموجودة في هذا الزر 

اذا كان ممكن ذلك فهل سيكون النقر لمدة 3 ثواني مثلا لكي ينفذ الأمر ام بالنقر المزدوج ؟؟

 

مع جزيل الشكر والتحية لجميع الأخوة الاعضاء

 

[ياسر خليل أبو البراء]

الأخ الكريم محمود

يرجى تغيير اسمك للغة العربية ليعبر عن شخصكم الكريم

 

إليك الملف التالي بمجرد النقر المزودج في العمود B يتم تنفيذ الماكرو

لنفرض أن لدينا الإجراء الفرعي التالي

Sub Test()
    MsgBox "Hello Mahmoud"
End Sub

ثم يوضع الكود التالي في حدث ورقة العمل

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Column = 2 Then
        Call Test
    End If
End Sub

أرجو أن يكون المطلوب إن شاء الله

Run Macro On Double Click.rar

[محمود1980]

الاخ ياسر المحترم 

بعد التحية 

 

1- شكرا على ملاحظتك بشأن الاسم .

2- شكرا على ردك  و على التجاوب السريع ، لقد تم حل المشكلة وهذا هو المطلوب بالفعل ، ولكن بعد تنفيذ حدث النقر تظهر الرسالة وبعد اغلاقها تصبح الخلية في وضع التحرير ، فهل هناك طريقة لتصبح الخلية بوضع التحديد أوان تنتقل الى الخلية التي تليها ؟

 

مع الشكر لجهودك

[ياسر خليل أبو البراء]

الاخ الكريم محمود 1980 ..

سهلة جداً أضف سطر واحد بسيط في نهاية الكود

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Column = 2 Then
        Call Test
    End If
    Cancel = True
End Sub

اكتشف السطر بنفسك

تقبل تحياتي

[محمود1980]

اخ ياسر مشكور جدا ، لقد اكتشفتها كما ذكرت 

سؤال أخير : 

اذا كان عندي معلومات في الخلية a2 و الخلية b2   ويوجد عندي ارقام في خلايا العمود f   السؤال هو :  هل يمكن اذا نقرنا مرتين على الخلية f45 مثلا ان يتم نسخ المعلومات الموجودة في الخلية a2   الى الخلية 45 j  

والمعلومات الموجودة في الخلية b2 الى الخلية k47  و هكذا 

ايضا اذا تم النقر مرتين على الخلية f47 مثلا ان يتم نسخ المعلومات الموجودة في الخلية a2   الى الخلية 47 j  

والمعلومات الموجودة في الخلية b2 الى الخلية k47  و هكذا 

اي عندما يتم النقر على اي خلية في العمود f يتم نسخ المعلومات الموجودة في الخلية a2  الى نفس رقم الخلية التي تم النقر عليها ولكن ضمن العمود j و ايضا يتم نسخ المعلومات الموجودة في الخلية b2  الى نفس رقم الخلية التي تم النقر عليها ولكن ضمن العمود k

شكرا لجهودكم    

[ياسر خليل أبو البراء]

أخي الكريم

أقترح طرح موضوع جديد مع إرفاق ملف للتوضيح

[محمود1980]

والله كلامك صحيح ، سوف اعد الملف وارسله في مشاركة جديدة .

[محمود1980]

في ١‏/٥‏/٢٠١٥ at 07:51, ياسر خليل أبو البراء said:

الأخ الكريم محمود

يرجى تغيير اسمك للغة العربية ليعبر عن شخصكم الكريم

 

إليك الملف التالي بمجرد النقر المزودج في العمود B يتم تنفيذ الماكرو

لنفرض أن لدينا الإجراء الفرعي التالي

Sub Test()
    MsgBox "Hello Mahmoud"
End Sub

ثم يوضع الكود التالي في حدث ورقة العمل

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Column = 2 Then
        Call Test
    End If
End Sub

أرجو أن يكون المطلوب إن شاء الله

Run Macro On Double Click.rar

الاخ ياسر شكرا دائما على تعاونك وتجاوبك 

سؤال : هل ممكن تنفيذ التعليمات اعلاه عند النقر على الخلية بالزر الايسر بعد ثانيتين بدل النقر المزدوج ؟ 

 

[محمود1980]

في ١‏/٥‏/٢٠١٥ at 07:51, ياسر خليل أبو البراء said:

الأخ الكريم محمود

يرجى تغيير اسمك للغة العربية ليعبر عن شخصكم الكريم

 

إليك الملف التالي بمجرد النقر المزودج في العمود B يتم تنفيذ الماكرو

لنفرض أن لدينا الإجراء الفرعي التالي

Sub Test()
    MsgBox "Hello Mahmoud"
End Sub

ثم يوضع الكود التالي في حدث ورقة العمل

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Column = 2 Then
        Call Test
    End If
End Sub

أرجو أن يكون المطلوب إن شاء الله

Run Macro On Double Click.rar

الاخ ياسر شكرا دائما على تعاونك وتجاوبك 

سؤال : هل ممكن تنفيذ التعليمات اعلاه عند النقر على الخلية بالزر الايسر بعد ثانيتين بدل النقر المزدوج ؟ 

 

[جعفر الطريبق]

في ٩‏/٨‏/٢٠١٨ at 06:59, محمود1980 said:

الاخ ياسر شكرا دائما على تعاونك وتجاوبك 

سؤال : هل ممكن تنفيذ التعليمات اعلاه عند النقر على الخلية بالزر الايسر بعد ثانيتين بدل النقر المزدوج ؟ 

 

Sub Test()
    MsgBox "Hello Mahmoud"
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Column = 2 Then
        Cancel = True
        Call Test
    End If
End Sub

 

عفوا لم أقرأ السوأل جيدا ... ظننت أنك طلب نتفيذ الكود عند النقر بازر الأيمن 

لكن سأحاول كتابة الكود المطلوب يعني عند النقر على الخلية بالزر الايسر ونشره هنا لتعميم الفائدة 

تم تعديل أغسطس 20, 2018 بواسطه جعفر الطريبق

[جعفر الطريبق]

برنامج اكسيل لا يتوفر على حدث النقر على الخلايا بالزر الأيسر.

الكود التالي كنت قد كتبته قبل فترة وعدلته بعض الشيئ لكي يشتغل فقط عندما ينقر المستخدم بالزر الأيسر على الخلايا الموجودة في العمود B و الشيت Sheet1.. يمكن تغيير العمود المستهدف و الورقة المستهدفة بسهولة في الحدث Wb_CellClick الموجود في ال ThisWorkBook Module

الجديد والمفيد في هذا الكود هو انه لا يشتغل عند الدخول الى الخلايا عن طريق لوحة الكيبورد كما هو الشان بالنسبة لحدث ال Worksheet_SelectionChange .. الكود التالي يشتغل فقط عند الدحول الى الخلايا عن طريق النقر بالماوس .

ملف للتحميل

 

1- أضف كلاس موديول جديد الى البروجيكت و سميه C_CellClickEvent

ضع الكود التالي في الكلاس موديول 

 

Code in C_CellClickEvent Class Module :

Option Explicit

Private WithEvents CmBrasEvents As CommandBars
Private WithEvents wbEvents As Workbook
Event CellClick(ByVal Target As Range)

Private Type POINTAPI
    x As Long
    Y As Long
End Type

Private Type KeyboardBytes
     kbByte(0 To 255) As Byte
End Type

#If VBA7 Then
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
    Private Declare PtrSafe Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
#Else
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
    Private Declare Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
#End If

Private kbArray As KeyboardBytes
Private oPrevSelection As Range

Private Sub Class_Initialize()
    Set CmBrasEvents = Application.CommandBars
    Set wbEvents = ThisWorkbook
    GetKeyboardState kbArray
    kbArray.kbByte(vbKeyLButton) = 0
    SetKeyboardState kbArray
End Sub

Private Sub Class_Terminate()
    Set CmBrasEvents = Nothing
    Set wbEvents = Nothing
End Sub

Private Sub CmBrasEvents_OnUpdate()
    Dim tpt As POINTAPI
    
    On Error Resume Next
    GetKeyboardState kbArray
    If GetActiveWindow <> Application.hwnd Then Exit Sub
    GetCursorPos tpt
    If GetKeyState(vbKeyLButton) = 1 Then
        If TypeName(ActiveWindow.RangeFromPoint(tpt.x, tpt.Y)) = "Range" Then
            If oPrevSelection.Address = ActiveWindow.RangeFromPoint(tpt.x, tpt.Y).Address Then
                RaiseEvent CellClick(Selection)
            End If
        End If
    End If
    kbArray.kbByte(vbKeyLButton) = 0
    SetKeyboardState kbArray
End Sub

Private Sub wbEvents_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    Set oPrevSelection = Target
End Sub

 

2- ضع الكود التالي في ال ThisWorkBook Module :

Option Explicit

Private WithEvents Wb As C_CellClickEvent

Private Sub Workbook_Open()
    Set Wb = New C_CellClickEvent
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Set Wb = Nothing
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Wb Is Nothing Then
        Set Wb = New C_CellClickEvent
    End If
End Sub

'Cell Click event handler
Private Sub Wb_CellClick(ByVal Target As Range)

If Target.Parent Is Sheet1 And Target.Column = 2 Then
    With Target
        .Font.Bold = True
        .Font.Name = IIf(.Value = "", "Wingdings", "calibri")
        .Value = IIf(.Value = "", "ü", "")
        MsgBox "You clicked cell : " & vbLf & .Address(External:=True), vbInformation
    End With
    
    End If
End Sub