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

السلام عليكم ورحمة الله وبركاته الاساتذة الافاضل بارك الله في جهودكم واساله سبحانه وتعالى ان يفيض عليكم من فضله خيرا وبركه طلب كود فورم اضافة بيانات جديد في وارقة codes NewForm.zip

اخي طاهر محمد إستخدام التنسيق الشرطي من الخلال دالة التسطير =AND($E10<>"";$E10>1)

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

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

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

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

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

نسخة الاكسيل 2010 و نسخة الويندوز 7 أدرج في موديول جديد وضع فيه الكود '-----Allows use of MouseWheel on designated ListBox/ComboBox on a form or, sheet if modified.-------- Option Explicit Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Declare Function GetForegroundWindow Lib "user32" () As Long Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long) Declare Function SetWindowsHookEx Lib _ "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _ ByVal hmod As Long, ByVal dwThreadId As Long) As Long Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Declare Function GetLastError Lib "kernel32" () As Long ' Used this one to crack the problem. Type POINTAPI X As Long Y As Long End Type Type MSLLHOOKSTRUCT 'Will Hold the lParam struct Data pt As POINTAPI mouseData As Long ' Holds Forward\Bacward flag flags As Long time As Long dwExtraInfo As Long End Type Const HC_ACTION = 0 Const WH_MOUSE_LL = 14 Const WM_MOUSEWHEEL = &H20A Dim hhkLowLevelMouse, lngInitialColor As Long Dim udtlParamStuct As MSLLHOOKSTRUCT Public Const GWL_HINSTANCE = (-6) Public intTopIndex As Integer Public ObjUSF As UserForm, ObjList As Object Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT ' VarPtr returns address; LenB returns size in bytes. CopyMemory VarPtr(udtlParamStuct), lParam, LenB(udtlParamStuct) GetHookStruct = udtlParamStuct End Function Function LowLevelMouseProc _ (ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 'Avoid XL crashing if RunTime error occurs due to Mouse fast movement On Error Resume Next ' \\ Unhook & get out in case the application is deactivated If GetForegroundWindow <> FindWindow("ThunderDFrame", ObjUSF.Caption) Then UnHook_Mouse Exit Function End If If (nCode = HC_ACTION) Then If wParam = WM_MOUSEWHEEL Then '\\ Don't process Default WM_MOUSEWHEEL Window message LowLevelMouseProc = True '\\ Change Sheet&\DropDown names as required With ObjList '\\ if rolling forward increase Top index by 1 to cause an Up Scroll If GetHookStruct(lParam).mouseData > 0 Then .TopIndex = intTopIndex - 1 '\\ Store new TopIndex value intTopIndex = .TopIndex Else '\\ if rolling backward decrease Top index by 1 to cause _ '\\a Down Scroll .TopIndex = intTopIndex + 1 '\\ Store new TopIndex value intTopIndex = .TopIndex End If End With End If Exit Function End If LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam) End Function Sub Hook_Mouse() ' Statement to maintain the handle of the hook if clicking outside of the control. ' There isn't a Hinstance for Application, so used GetWindowLong to get handle. If hhkLowLevelMouse < 1 Then hhkLowLevelMouse = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, _ GetWindowLong(FindWindow("ThunderDFrame", ObjUSF.Caption), GWL_HINSTANCE), 0) End Sub Sub UnHook_Mouse() If hhkLowLevelMouse <> 0 Then UnhookWindowsHookEx hhkLowLevelMouse hhkLowLevelMouse = 0 End If End Sub اضف هدا الكود في الفورم ' Check to see if focus is lost Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) UnHook_Mouse End Sub Private Sub ListBox1_Change() intTopIndex = Me.ListBox1.TopIndex End Sub Private Sub ListBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) UnHook_Mouse End Sub Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) ' Définir les noms des objet à l'ouverture de l'USF ' sont utilisés dans le code du hook Set ObjUSF = Me: Set ObjList = Me.ListBox1 'Store the first TopIndex Value intTopIndex = Me.ListBox1.TopIndex ' Hook_Mouse End Sub Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) UnHook_Mouse End Sub

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

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

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

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

اخي ياسر خليل أبو البراء بارك الله فيك على هذه النصيحة والافادة جزاكم الله خير Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Row > 9 Then If Target.Column = 6 Or Target.Column = 8 Then Application.ScreenUpdating = False Dim I As Long With Sheet1 For I = 10 To .Cells(60, "F").End(xlUp).Row .Cells(I, "I") = .Cells(I, "F") * .Cells(I, "H") Next I .Range("I61") = Application.Sum(.Range("I10:I60")) Range("I64").Formula = "=+I62+I61-I63" End With Application.ScreenUpdating = True End If End If End Sub

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

جزاك الله خيرا اخي ياسر خليل أبو البراء وارجو المعذرة الكود لم يشتغال في الخانة 62/63

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

هل من طريقة لاشتغال الكود تلقائيا دون الضغط على الزر

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

بارك الله فيك اخي ياسر خليل أبو البراء على جهودك اريد ضرب الكمية في سعر الكمية في عمود f سعر في عمود H تم تكون القيمة في عمود I ابتداء من من سطر 10 الى سطر 60 تم الجمع في i 61 العطارتمسنا_2015_07_21.zip

بارك الله فيك اخي ياسر خليل أبو البراء على جهودك طلب كود يقوم باستخراج القيمه الخاصه بكل صنف ثم استخراج اجمالى قيمة الفاتوره تم هد المعادلة =+I62+I61-I63

طلب معادلة لجمع الفاتورة كود من نطاق i10 الى نطاق i60 تم الجمع الفاتو رة في i61 تم هد المعادلة =+I62+I61-I63 العطارتمسنا_2015_07_21.zip

اليك المرفق اخى عبد الواحد بعد اجراء التعديل المطلوب souris.zip

بارك الله فيك أستاذنا الفاضل خالد الرشيدي على أعمالك الرائعة جزاك الله خير اًاخى الحبيب

بارك الله فيك أستاذنا الفاضل خالد الرشيدي على أعمالك الرائعة

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