mahmoud nasr alhasany

السلام عليكم ورحمة الله وبركاتة تم حل مشكلة الاصناف الراكدة وجلبها فى سيت اصناف راكدة اولا الرجاء مساعدتى فى تنسيق التاريخ فى العمود D ثانيا / اريد مساعدتى فى مقارنة الاصناف الراكدة والمتحركة فى شيت مفصل لتوزيعها والخروج من حالة ركود الاصناف من خلال كل فرع بمعنى ان يوجد صنف بها حالة ركود فى فرع1 ونفس الصنف يوجد بها حركة فى فرع اخر مما يسبب حالة الركود فى انتهاء صلاحية المنتج فعندما اجد الفرع الذى يوجد بها حركة اقوم فورا بأرسالها الى الفرع ملحوظة الافرع عبارة عن محافظات Copy of الاصناف الراكدة لكل مخزن(3) - Copy - Copy.xlsm

اريد استدعاء كل البيانات والاصناف الراكدة بناء على عدد الاصناف الراكدة بالاغلى الاصناف الراكدة لكل مخزن(1) - Copy - Copy.xlsm

الف شكر ا/ محمد هشام للمساعدة هل يمكن اضافة وارفاق كود واسم الصنف والكمية مع التقرير اى البيانات الليس عليها اى حركة او حركتها ضعيفة نسبة للكمية والصلاحية الاصناف الراكدة لكل مخزن(1).xlsm

السلام عليكم ورحمة تالله وبركاتة الرجاء مساعدتى اذا سمحتم يوجد شيت تجريبى نبذة للعمل المطلوب اريد معرفة الاصناف الراكدة والمتحركة لكل مخزن كما هو موضح فى الكود يوجد مشكلة فى الكود لعدم استعراض الاصناف الراكدة وذلك من خلال صلاحية حركة المنتج والكمية Sub FindStagnantItems() Dim ws As Worksheet, wsOutput As Worksheet Dim lastRow As Long, i As Long Dim item As String, category As String, lastMovementDate As Date Dim stagnantItemsByCategory As Object Dim warehouseNames As Variant Dim stagnantPeriod As Integer Dim totalStagnantItemsByCategory As Object ' تحديد الفترة التي تعتبر بعدها الصنف راكدًا stagnantPeriod = 90 ' تحديد أسماء أوراق العمل التي تمثل المخازن warehouseNames = Array("مخزن الرئيسي", "فرع 1") ' إنشاء قاموس لتخزين الأصناف الراكدة حسب التصنيف Set stagnantItemsByCategory = CreateObject("Scripting.Dictionary") Set totalStagnantItemsByCategory = CreateObject("Scripting.Dictionary") ' تكرار العملية لكل مخزن For Each warehouseName In warehouseNames On Error Resume Next Set ws = ThisWorkbook.Sheets(warehouseName) If Err.Number <> 0 Then MsgBox "حدث خطأ في الوصول إلى ورقة العمل: " & Err.Description Exit Sub End If On Error GoTo 0 lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row ' البحث عن الأصناف الراكدة في المخزن الحالي For i = 2 To lastRow item = ws.Cells(i, 1).Value category = ws.Cells(i, 4).Value lastMovementDate = ws.Cells(i, 3).Value If DateDiff("d", lastMovementDate, Date) > stagnantPeriod Then If Not stagnantItemsByCategory.Exists(category) Then stagnantItemsByCategory.Add category, New Collection End If stagnantItemsByCategory(category).Add item ' حساب إجمالي الأصناف الراكدة لكل تصنيف If Not totalStagnantItemsByCategory.Exists(category) Then totalStagnantItemsByCategory.Add category, 1 Else totalStagnantItemsByCategory(category) = totalStagnantItemsByCategory(category) + 1 End If End If Next i Next warehouseName ' إنشاء ورقة عمل جديدة لعرض النتائج Set wsOutput = Worksheets.Add wsOutput.Name = "أصناف راكدة" wsOutput.Range("A1").Value = "التصنيف" wsOutput.Range("B1").Value = "عدد الأصناف الراكدة" ' عرض النتائج Dim categoryName As Variant Dim currentRow As Long currentRow = 2 For Each categoryName In totalStagnantItemsByCategory.Keys wsOutput.Cells(currentRow, 1).Value = categoryName wsOutput.Cells(currentRow, 2).Value = totalStagnantItemsByCategory(categoryName) currentRow = currentRow + 1 Next categoryName End Sub الاصناف الراكدة لكل مخزن.xlsm

بعد استاذنا الرائع / محمد هشام. اولا هذا المجهود بعد فضل الله يرجع للاستاذ محمد هشام و الاستاذ / حسونة حسين لقد تعلمنا منهما الكثير اسأل الله ان يمن عليهم بالخير الكثير هذا الكود VBA بدون ادخال صيغ حسابية فى ورقة العمل فى العمود G وشرحها كالاتى تعطيل الأحداث: نمنع حدوث أي تغييرات أخرى أثناء تنفيذ الكود لتجنب التكرار اللانهائي. التحقق من الخلية المتغيرة: نتأكد من أن الخلية التي تم تغييرها تقع في العمودين F أو E وأنها ضمن نطاق البيانات. التحقق من صحة البيانات: نتأكد من أن القيم المدخلة في الخليتين F و E هي أرقام. إذا كانت القيم غير رقمية، يتم عرض رسالة خطأ للمستخدم. حساب المجموع الكلي: نقوم بضرب قيمة الكمية في سعر الوحدة ونضع النتيجة في العمود G. تحديد ورقة العمل: يتم تحديد الورقة التي تحتوي على البيانات التي تريد تطبيق التنسيق الشرطي عليها. تحديد النطاق: يتم تحديد النطاق الذي يحتوي على القيم التي سيتم تطبيق التنسيق الشرطي عليها. في هذا المثال، يتم تطبيق التنسيق على العمود G بدءًا من الصف الثاني وحتى آخر صف يحتوي على بيانات. حذف التنسيق الشرطي الحالي: يتم حذف أي تنسيق شرطي موجود مسبقًا على النطاق المحدد. إضافة تنسيق شرطي جديد: يتم إضافة شرط جديد حيث يتم تلوين الخلايا باللون الأحمر إذا كانت قيمتها أقل من صفر (أي سالبة). تخصيص التنسيق: يمكنك تغيير لون الخط، حجم الخط، الخط العريض، والمائل وغيرها من خصائص التنسيق حسب رغبتك. Private Sub Worksheet_Change(ByVal Target As Range) ' تحديد ورقة العمل والعمود الأخير للبيانات Dim WS As Worksheet: Set WS = Sheets("فاتورة مبيعات") Dim Lr As Long: Lr = WS.Cells(WS.Rows.Count, "F").End(xlUp).Row ' تعطيل أحداث التغيير مؤقتًا لمنع التكرار اللانهائي Application.EnableEvents = False ' التحقق من أن الخلية المتغيرة تقع في العمودين F أو E If Not Intersect(Target, WS.Range("F:E")) Is Nothing Then ' التأكد من أن الصف المتغير ضمن نطاق البيانات If Target.Row <= Lr Then ' التحقق من أن القيم المدخلة هي أرقام If IsNumeric(Target.Value) And IsNumeric(WS.Cells(Target.Row, "E").Value) Then ' حساب المجموع الكلي وتعيينه في الخلية المناسبة WS.Cells(Target.Row, "G").Value = Target.Value * WS.Cells(Target.Row, "E").Value Call staining_negative_cells Else MsgBox "الرجاء إدخال قيم رقمية صحيحة في عمودي الكمية والسعر." End If End If End If ' إعادة تمكين أحداث التغيير Application.EnableEvents = True End Sub Sub staining_negative_cells() Dim WS As Worksheet Set WS = Sheets("فاتورة مبيعات") ' استبدل باسم الورقة التي تريدها ' تحديد النطاق الذي تريد تطبيق التنسيق الشرطي عليه With WS.Range("G2:G" & WS.Cells(WS.Rows.Count, "G").End(xlUp).Row) .FormatConditions.Delete .FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="0" With .FormatConditions(1).Font .Color = -16776961 ' لون أحمر .Bold = True End With End With End Sub طط.rar

لقد وجدت المشكلة هذا هو الحل Sub Account_fund_balances_Array() Dim LastRow As Long Dim data As Variant Dim i As Long With Worksheets("Sheet4") LastRow = .Cells(.Rows.Count, "I").End(xlUp).Row data = .Range("I2:j" & LastRow).value For i = 2 To UBound(data) If IsNumeric(data(i, 1)) And IsNumeric(data(i, 2)) Then data(i, 1) = data(i, 1) - data(i, 2) + data(i - 1, 1) Else ' استبدال القيم غير الرقمية بصفر (يمكنك تغيير هذه القيمة) data(i, 3) = 0 MsgBox "وجدت قيمة غير رقمية في الصف " & i & ". تم استبدالها بصفر." End If Next i .Range("K2:K" & LastRow).value = data End With End Sub

السلام عليكم ورحمة الله وبركاتة اريد تحديث خزينة الصندوق يوجد مشكله فى الكود Sub RoundedRectangle1_Click() Dim LastRow As Long Dim data As Variant Dim i As Long With Worksheets("خزينة") LastRow = .Cells(.Rows.Count, "I").End(xlUp).Row data = .Range("I2:K" & LastRow).Value For i = 2 To UBound(data) If IsNumeric(data(i, 1)) And IsNumeric(data(i, 2)) Then data(i, 3) = data(i, 1) - data(i, 2) + data(i - 1, 3) Else ' استبدال القيم غير الرقمية بصفر (يمكنك تغيير هذه القيمة) data(i, 3) = 0 MsgBox "وجدت قيمة غير رقمية في الصف " & i & ". تم استبدالها بصفر." End If Next i .Range("K2:K" & LastRow).Value = data End With End Sub اريد كود مثل الخزينة يقوم بعمل طرح من الخلية i2....xlsm

الف شكر استاذنا / ابو عارف لقد تم عمل المطلوب

شكرا جزيلا اخى ابو عارف لقد نجحت العملية وتم اكمال الامر ولاكن كنت اريد تنفيذ الفكرة من خلال اكواد vba من داخل الفورم لقد وجدت اكواد تفعل ذلك ولاكنى عندى صعوبة فى كتابة الارقام باللغة العربية داخل محرر الاكواد كمثال هذ الكود Private Sub CommandButton1_Click() With ListBox1 .AddItem ComboBox1.value .List(.ListCount - 1, 1) = TextBox1.value .List(.ListCount - 1, 2) = ConvertArabicToEnglishWithArabicLetters(TextBox2.value) Me.ListBox1.ColumnCount = 3 Me.ListBox1.ColumnWidths = "40;50;50" End With End Sub Private Function ConvertArabicToEnglishWithArabicLetters(ByVal ArabicText As String) As String Dim i As Integer Dim EnglishText As String Dim ArabicDigits As String Dim EnglishDigits As String ' Define Arabic and English digits 'المفروض داخل علامة التنصيص تكون الارقام عربية ArabicDigits = "0123456789" 'اريد كتابة الارقام هنا بعد علامة التنصيص"ارقام عربية من صفر الى تسعة" 'المفروض داخل علامة التنصيص تكون الارقام انجليزية EnglishDigits = "0123456789" For i = 1 To Len(ArabicText) ' Check if the character is an Arabic digit If InStr(ArabicDigits, Mid(ArabicText, i, 1)) > 0 Then ' Replace Arabic digit with English digit EnglishText = EnglishText & Mid(EnglishDigits, InStr(ArabicDigits, Mid(ArabicText, i, 1)), 1) Else ' Keep the character as it is (including Arabic letters) EnglishText = EnglishText & Mid(ArabicText, i, 1) End If Next i ConvertArabicToEnglishWithArabicLetters = EnglishText End Function

اشكرك على مساعدتى 1 / ابو عارف اريد تنفيذ الكود في حدث بعد تحديث TextBox2 بحيث يظهر فى لليست بوكس الحروف عربية والارقام انجليزية

احسنت استاذنا الغالى / محمد هشام

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

كود برمجي لارسال رساله عبر الواتس اب من الاكسيل الحل المثالي لارسال اكبر عدد من الرسائل من الاكسيل للواتس اب الجديد الكود البرمجي كامل : Sub sendMessage() Dim contact As String Dim text As String num = Application.WorksheetFunction.CountA(Sheets("data").Range("a:a")) - 2 ActiveWorkbook.FollowHyperlink Address:="https://web.whatsapp.com/" Application.Wait (Now + TimeValue("00:00:07")) For I = 0 To num contact = Sheets("data").Range("c2").Offset(I, 0).Value text = Sheets("data").Range("g2").Offset(I, 0).Value Call SendKeys("^%{/}", True) Application.Wait (Now + TimeValue("00:00:05")) Call SendKeys(contact, True) Application.Wait (Now + TimeValue("00:00:05")) Call SendKeys("~", True) Application.Wait (Now + TimeValue("00:00:05")) Call SendKeys(text, True) Application.Wait (Now + TimeValue("00:00:01")) Call SendKeys("~", True) Application.Wait (Now + TimeValue("00:00:01")) Call SendKeys("^%{/}", True) Next I End Sub إرسال رسائل واتساب من إكسل: تُستخدم هذه العبارة بشكل عام للبحث عن طرق إرسال رسائل واتساب من خلال ملف إكسل. ربط إكسل بواتساب: تُشير هذه العبارة إلى البحث عن حلول لربط ملف إكسل بتطبيق واتساب لتمكين إرسال الرسائل تلقائيًا. ماكرو إكسل لإرسال رسائل واتساب: تُستخدم هذه العبارة للبحث عن أكواد ماكرو مخصصة لإكسل تسمح بإرسال رسائل واتساب. أدوات إرسال رسائل واتساب من إكسل: تُشير هذه العبارة إلى البحث عن برامج أو تطبيقات خارجية تعمل كوسيلة وسيطة لإرسال الرسائل من إكسل إلى واتساب. إرسال رسائل واتساب تلقائيًا من إكسل ربط إكسل بواتساب إرسال رسائل واتساب من إكسل . أتمتة واتساب باستخدام إكسل . VBA لربط إكسل بواتساب . ماكرو إكسل لواتساب . وهذا ملف اخر عدلة كما تريد اسهل طريقة ارسال وربط ملف الاكسيل بالواتس اب وارسال رسائل المدرسة او الشركة من الاكسيل للواتس اب.xlsm

السلام عليكم ورحمة الله وبركاتة رجاء مساعدتى اذا سمحتم يوجد بيانات يتم تحويلها من التكست بوكس الى الليست بوكس بيانات ارقام سيارة وقيمة التفويل وبيان اللتر سولار بالارقام والحروف اريد فى حدث TEXTBOX2 يتم تحويل الارقام من العربية الى الانجليزية فى شيت 1 فى العمود 3 كمثال من لتر سولار 20.13 (للاسف لايمكن كتابة الحروف باللغة العربية ) الى لتر سولار 20.13 تحويل الارقام من العربية الى الانجليزية.xlsm

تم الحل ولاكن بكود مختلف اخر Sub UpdateStock() Dim ws As Worksheet Dim lastRow As Long, foundRow As Long Dim item As String, fromStore As String, selectedDate As Date Dim quantity As Long Dim foundMatch As Boolean Set ws = ThisWorkbook.Sheets("Sheet1") item = ComboBox4.Value fromStore = ComboBox2.Value selectedDate = CDate(TextBox15.Value) quantity = CLng(TextBox8.Value) If quantity <= 0 Then MsgBox "الكمية المحولة يجب أن تكون أكبر من الصفر", vbExclamation Exit Sub End If foundMatch = False ' Flag to indicate if a match is found With ws.Range("A2:G" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) Set foundCell = .Find(What:=item, LookIn:=xlValues, LookAt:=xlWhole, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not foundCell Is Nothing Then firstAddress = foundCell.Address Do If ws.Cells(foundCell.Row, 3).Value = fromStore And _ ws.Cells(foundCell.Row, 7).Value = selectedDate Then ws.Cells(foundCell.Row, 6).Value = ws.Cells(foundCell.Row, 6).Value + quantity foundMatch = True Exit Do End If Set foundCell = .FindNext(After:=foundCell) Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress End If ' Add new row only if no exact match was found If Not foundMatch Then lastRow = ws.UsedRange.Rows.Count + 1 With ws.Rows(lastRow) .Cells(1).Value = item .Cells(2).Value = ComboBox3.Value .Cells(3).Value = fromStore .Cells(4).Value = TextBox7.Value .Cells(5).Value = TextBox1.Value .Cells(6).Value = TextBox8.Value .Cells(7).Value = TextBox15 End With MsgBox "تم إضافة صف جديد بنجاح", vbInformation ElseIf foundMatch Then MsgBox "تم تحديث الكمية في الصف الموجود", vbInformation End If End With End Sub Private Sub CommandButton4_Click() Call UpdateStock End Sub

السلام عليكم ورحمة الله وبركاته الرجاء مساعدتى فى اضافة الكمية للمخزون على حسب كود الصنف والمخزن و تاريخ الصلاحية المطابقة لها اما اذا كانت يوجد صلاحية جديده للمنتج فيتم اضافة سطر جديد اريد تكرار الصنف والمخزن عادى مادام يوجد تاريخ صلاحية مختلفة وليست مطابقة للمخزن والصنف وتاريخ الصلاحية معا المشكلة فى فورم userform4 المشكلة فى التاريخ selectedDate = CDate(TextBox15.Value) فعندما يتوافق كود الصنف والمخزن وصلاحية المنتج معا يتم اضافة الكمية لهذ الصنف اذا كانت التاريخ متوافق ولاكن لو كان يوجد صلاحية تاريخ جديد يتم اضافة سطر جديد كود صنف ومخزن وكمية وصلاحية فوجد ان الكمية تضاف للمخزن اذا كانت الصلاحية متوافقة مثل 01/01/2024 ولاكن لو كانت صلاحية اخرى مثل اى تاريخ 02/01/2024 او 03/01/2024 والخ يتم اضافة سطر جديد مع العلم ان التاريخ لهذا الصنف والمخزن موجود والمفروض يتم اضتافة الكمية للمخزون وليس اضافة سطر جديد Private Sub CommandButton4_Click() Dim ws As Worksheet Dim lastRow As Long Dim item As String, fromStore As String Dim selectedDate As Date ' تعريف المتغير كـ Date مباشرة Dim quantity As Long Dim foundRow As Long Set ws = ThisWorkbook.Sheets("sheet1") ' تحسين: استخدام Find بدلاً من قراءة المصفوفة بالكامل With ws.columns("A") ' البحث في العمود A فقط lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row item = ComboBox4.Value fromStore = ComboBox2.Value selectedDate = CDate(TextBox15.Value) ' لا داعي لـ Format هنا، CDate يتعامل مع التواريخ بشكل جيد quantity = CLng(TextBox8.Value) If quantity <= 0 Then MsgBox "الكمية المحولة يجب أن تكون أكبر من الصفر", vbExclamation Exit Sub End If ' البحث عن التطابق Set foundCell = .Find(What:=item, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) If Not foundCell Is Nothing Then foundRow = foundCell.row ' التحقق من تطابق باقي الشروط في نفس الصف If ws.Cells(foundRow, 3).Value = fromStore And ws.Cells(foundRow, 7).Value = selectedDate Then ws.Cells(foundRow, 6).Value = ws.Cells(foundRow, 6).Value + quantity 'تحديث مباشر للكمية المخزون في الخلية على حسب نوع المخزن وكود الصنف و مطابقة التاريخ معا ' Exit Sub 'الخروج من الإجراء بعد التحديث End If End If End With ' إذا لم يتم العثور على تطابق المخزن وكود الصنف بسبب تاريخ صلاحية جديدة، يتم إضافة صف جديد lastRow = lastRow + 1 With ws.Rows(lastRow) ' استخدام With لتسهيل الكتابة .Cells(1).Value = item .Cells(2).Value = ComboBox3.Value .Cells(3).Value = fromStore .Cells(4).Value = TextBox7.Value .Cells(5).Value = TextBox1.Value .Cells(6).Value = TextBox8.Value .Cells(7).Value = selectedDate End With ' اضافة البيانات سواء كانت تحويلات او شراء الى ورقة تسجيل البيانات Dim wss As Worksheet Dim lastRow1 As Long Dim serialNumber As Long serialNumber = 1 ' تحديد ورقة العمل (قم بتغيير "Sheet1" إذا لزم الأمر) Set wss = ThisWorkbook.Sheets("تسجيل البيانات") ' العثور على آخر صف يحتوي على بيانات في العمود A lastRow1 = wss.Cells(Rows.Count, "A").End(xlUp).row serialNumber = lastRow1 '+ 1 ' كتابة القيم في الصف التالي lastRow1 = lastRow1 + 1 wss.Cells(lastRow1, "A").Value = TextBox5 wss.Cells(lastRow1, "B").Value = TextBox6 wss.Cells(lastRow1, "C").Value = ("شراء") wss.Cells(lastRow1, "D").Value = ComboBox4.Value wss.Cells(lastRow1, "E").Value = ComboBox3.Value wss.Cells(lastRow1, "F").Value = ComboBox2.Value wss.Cells(lastRow1, "g").Value = ComboBox1.Value wss.Cells(lastRow1, "h").Value = TextBox7.Value wss.Cells(lastRow1, "i").Value = TextBox1.Value wss.Cells(lastRow1, "j").Value = TextBox8.Value wss.Cells(lastRow1, "k").Value = TextBox9.Value wss.Cells(lastRow1, "l").Value = TextBox10.Value wss.Cells(lastRow1, "m").Value = TextBox11.Value wss.Cells(lastRow1, "n").Value = TextBox12.Value wss.Cells(lastRow1, "o").Value = TextBox15.Value wss.Cells(lastRow1, "p").Value = Format(Now, "DDDD MM/DD/YYYY HH:MM:SS AM/PM") 'dddd, dd mm, yyyy hh:mm:ss AM/PM End Sub stock.xlsm

الف شكر 1 / محمد هشام. احسنت والله

للاسف لقد لاحظت يوجد خطاء فى التنقل بين البيانات فى الفورم اريد تنقل البيانات مثل ترتيب هذا الاعمدة Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("تسجيل البيانات") TextBox7.Text = ws.Cells(rowNum, 2).Value ComboBox1.Text = ws.Cells(rowNum, 4).Value ComboBox2.Value = ws.Cells(rowNum, 5).Value ComboBox3.Value = ws.Cells(rowNum, 6).Value ComboBox4.Value = ws.Cells(rowNum, 7).Value TextBox3.Text = ws.Cells(rowNum, 8).Value TextBox4.Text = ws.Cells(rowNum, 9).Value TextBox5.Text = ws.Cells(rowNum, 10).Value TextBox6.Text = ws.Cells(rowNum, 11).Value ComboBox5.Value = ws.Cells(rowNum, 12).Value

احسنت 1 / محمد هشام. الف شكر لك

احسنت ا / محمد هشام.

السلام عليكم ورحمة الله وبركاته الرجاء مساعدتى فى هذا العمل اريد التنقل بين السجلات برقم الفاتورة فقط دون غيرها من ارقام الفواتير الاخرى فى textbox8 من خلال SpinButton2_SpinDown SpinButton2_SpinUp Private Sub TextBox8_Change() Dim ws As Worksheet Dim rng As Range Dim foundRows As New Collection Dim i As Long Set ws = ThisWorkbook.Sheets("تسجيل البيانات") Set rng = ws.Range("A2:L10000") ' foundRows.RemoveAll For Each cell In rng.Columns(1).Cells If cell.Value = TextBox8.Text Then foundRows.ADD cell.Row End If Next cell If foundRows.Count = 0 Then MsgBox "No matching records found." Exit Sub End If ' Display the first match i = 1 DisplayRecord (foundRows(i)) End Sub Private Sub SpinButton2_SpinDown() If i > 1 Then i = i - 1 DisplayRecord (foundRows(i)) End If End Sub Private Sub SpinButton2_SpinUp() If i < foundRows.Count Then i = i + 1 DisplayRecord (foundRows(i)) End If End Sub Private Sub DisplayRecord(rowNum As Long) Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("تسجيل البيانات") TextBox7.Text = ws.Cells(rowNum, 2).Value ComboBox1.Text = ws.Cells(rowNum, 4).Value ComboBox2.Value = ws.Cells(rowNum, 5).Value ComboBox3.Value = ws.Cells(rowNum, 6).Value ComboBox4.Value = ws.Cells(rowNum, 7).Value TextBox3.Text = ws.Cells(rowNum, 8).Value TextBox4.Text = ws.Cells(rowNum, 9).Value TextBox5.Text = ws.Cells(rowNum, 10).Value TextBox6.Text = ws.Cells(rowNum, 11).Value ComboBox5.Value = ws.Cells(rowNum, 12).Value End Sub textbox8 بحث والتنقل بين السجلات برقم الفاتورة.xlsm

تم عمل المطلوب قنم بوضع الاسم فى الفورم 2 textbox3 ثم قم باختيار من لوحة المفاتيح الامر F4 للانتقال بوضع الاسم الذى تم اختيارة فى listbox1 من خلال انتقال الاسهم من لوحة المفاتيح بعد الامر مباشرة F4 وعند اختيار الاسم المحدد قم باختيار الامر F2 للانتقال الى الفورم 1 وشكرا شاشة عميل بحث(1).xlsm

الف شكر استاذ / أبومروان انه يعمل اريد ان تساعدنى فى ان افعل الاسهم بتاعت الكيبورت للانتقال اعلى واسفل من خلال الليست بوكس بعد تحديد اول بيانات الاسم فى الليست بوكس شاشة عميل بحث(1).xlsm

السلام عليكم ورحمة الله وبركاتة تحية طيبة وبعد اريد مساعدتى فى تشغيل تشغيل مفتاح F4 في حدث فورم VBA Excel والانتقال الى القائمة فى LISTBOX1 وايضا تشغيل مفتاح F2 في حدث فورم VBA Excel والانتقال الى Userform1 الى حدث combobox1 من خلال تحديد الاسم الموجود فى LISTBOX1 فى Userform2 كمثال فى Userform2 يوجد textbox3 اضع اول حرف او اسم فى textbox3 وعند الضغط على مفتاح F4 ينتقل الى اول الاسماء فى LISTBOX1 وعند تحديد اسم فى LISTBOX1 وعند الضغط على مفتاح F2 ينتقل بعد تحديد الاسم فى LISTBOX1 الى Userform1 الى حدث combobox1 وشكرا شاشة عميل بحث.xlsm

الف شكر استاذنا / محمد هشام على المجهود الرائع تسلم ايدك احسنت والله