هل هناك طريقه استعمل الزر enter مع ليست بوكس

[محمد عبدالسلام]

السلام عليكم  طلب استفسار

هل هناك طريقه لستعمل الزر enter  لوحة  المفاتيح  في اللست بوكس

 

تم تعديل سبتمبر 4, 2015 بواسطه محمد عبدالسلام

[إبراهيم ابوليله]

اخى محمد

يرجى وضع مرفق للعمل عليه

وذلك تيسرا على الاخوه الاعضاء فى مساعدتك

على العموم

ضع هذه الاكواد داخل الفورم

لعلها تكون ماتريد

Private Sub UserForm_Activate()
With Me.ListBox1
.AddItem "ابراهيم"
.AddItem "محمد"
.AddItem "ابراهيم"
.AddItem "ابوليله"
End With
End Sub

Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
MsgBox "h"
TextBox1.Value = ListBox1.Column(0)
End If
End Sub

 

تقبل تحياتى

تم تعديل سبتمبر 4, 2015 بواسطه إبراهيم ابوليله

[محمد عبدالسلام]

بارك الله فيك اخي الكريم  إبراهيم ابوليله الاخوه الاعضاء على المساعدة جزاكم الله خير ونفع بكم الاسلام والمسلمين اقصيد هل هناك طريقه لستعمل الزر enter   في اللست بوكس بدلا من الموس كمتل بدلا من عمل كلك بي الموس على البيانات يتم عمل  enter في ترحيل البيانات لي الفاتورة

 

 

enter.zip

[إبراهيم ابوليله]

اخى محمد

لديلك فى الملف المرفق

عدد  يوزر فورم

اى يوزر فيه تريد ترحيل بيانات الصف المختار في الليست الموجوده به

تقبل تحياتى

اخى محمد

على العموم

جرب وضع هذه الكود داخل الفورم

Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
Dim rng As Range, LR As Long
Dim x
x = Application.InputBox("Please enter a Quntity", , , , , , , 1)
If x = False Then
    Exit Sub
Else
LR = Sheets("invoice").Cells(Rows.Count, "E").End(xlUp).Row + 1
Set rng = Sheets("invoice").Cells(LR, 4)
    
If ListBox1.Value <> "" Then
rng.Value = ListBox1.Value
rng.Offset(0, 1).Value = ListBox1.List(ListBox1.ListIndex, 1)
rng.Offset(0, 4).Value = ListBox1.List(ListBox1.ListIndex, 2)
rng.Offset(0, 2).Value = x
End If
End If
End If
End Sub

تقبل تحياتى

[محمد عبدالسلام]

اخي إبراهيم ابوليله والله مالقيت الكلمات التى  اعبر لك عن شكري  لانك انسان مبدع

هدا هو الكودالمطلوب بارك الله فيك اخي الكر م لكن توجد ملاحظات ادا كان من الممكن اريد لما اعمل enter يتم ترحيل وادخل الكمية

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

ترحيل من UserForm1 

 

 

تم تعديل سبتمبر 4, 2015 بواسطه محمد عبدالسلام

[إبراهيم ابوليله]

اخى محمد

ممكن التوضيح اكثر

لاننى بصراحه مش فاهم حاجه خالص

ياريت لو تضلاب لنا ميثال لما تريده

تقبل تحياتى

[محمد عبدالسلام]

اريد استخدام لوحة المفاتيح في اللست بوكس فقط دون الولوج لي الماوس لي الاان لما عمل enter مشكلة الوحة المفاتح  لم تعد تتعرف على اللست بوكس حتى اعمل كلك بي الماوس

 

تم تعديل سبتمبر 5, 2015 بواسطه محمد عبدالسلام

[إبراهيم ابوليله]

بردو مش فاهم

يا اخى محمد حاول تبسيط الامر ان امكن

انت عايز تعمل ايه بالضبط

تقبل تحياتى

[محمد عبدالسلام]

اخي إبراهيم ابوليله ارجو المعذرة لقد اتعبتك معي

 

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

enter.zip

[عبد العزيز البسكري]

السّلام عليكم و رحمة الله و بركاته

أخي محمد عبد السلام .. أنا بدوري قمت بتجريب الملف مرارًا و تكرارًا .. ويشتغل بكيفية سليمة مئة بالمئة ..

 

[محمد عبدالسلام]

لسّلام عليكم و رحمة الله و بركاته

اخي الفاضل عبد العزيز البسكري جزاك الله خيرا الملف يشتغل مئة بالمئة الا انها لم تتم كلها بلوحة المفاتح دون استغناء عن الماوس اريد الاستغناء عنه ويتم كل لعمل بي الوحة المفاتح فقط

[محمد عبدالسلام]

اخي إبراهيم ابوليله على كل حال  لقد تعبت معى شكرا لك بارك الله فيك وجعله في ميزان حسناتك

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

لا تستعمل Application.InputBox

افضل استعمال vba.InputBox

 

Private Sub CommandButton1_Click()
Unload Me
End Sub




Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
Dim rng As Range, LR As Long
Dim x
x = InputBox("Please enter a Quntity")
If x = False Or StrPtr(x) = 0 Or Not IsNumeric(x) Then
    Exit Sub
Else
LR = Sheets("invoice").Cells(Rows.Count, "E").End(xlUp).Row + 1
Set rng = Sheets("invoice").Cells(LR, 4)
    
If ListBox1.Value <> "" Then
rng.Value = ListBox1.Value
rng.Offset(0, 1).Value = ListBox1.List(ListBox1.ListIndex, 1)
rng.Offset(0, 4).Value = ListBox1.List(ListBox1.ListIndex, 2)
rng.Offset(0, 2).Value = x
End If
End If
End If
End Sub

Private Sub TextBox1_Change()
Dim LR As Integer, R As Integer, T As Integer
ListBox1.Clear
With Sheets("Codes")
    LR = .Cells(.Rows.Count, 2).End(xlUp).Row
    For R = 2 To LR
        If .Cells(R, 2) Like "*" & TextBox1.Text & "*" Then
            ListBox1.AddItem
            ListBox1.List(T, 0) = .Cells(R, 1)
            ListBox1.List(T, 1) = .Cells(R, 2)
            ListBox1.List(T, 2) = .Cells(R, 4)
            ListBox1.List(T, 3) = .Cells(R, 5)
            T = T + 1
        End If
    Next
End With
End Sub


Private Sub UserForm_Activate()
TextBox1_Change
ListBox1.ListIndex = 0
End Sub

 

[إبراهيم ابوليله]

اخى جعفر

منور المشاركه

بارك الله فيك

.............................................

اخى محمد

كما قال اخونا عبد العزيز

الكود يعمل بنجاح

ولكن جرب كود اخانا جعفر

تقبلو تحياتى

[محمد عبدالسلام]

 اخى جعفر إبراهيم ابوليله هدا هوالمطلوب بارك الله فيكم ونفع بكم الاسلام والمسلمين

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

أخي الغالي جعفر

بارك الله فيك وجزاك الله خير الجزاء

أدامك الله لنا ذخراً ونبراساً للعلم