الجموعي

up

للرفع

اولا يتم البحث بواسطة الكمبوبوكس 1 تظهر النتائج في اللست بوكس وعنذ اختيار يتم ترحيلها للتكست بوكس عند التعدل يتم التعديل تمام الان نبحث بالكمبوبوكس 1 ثم ننتقل مباشرة لعملية الفرز بواسطة الكمبوبوكس2 يتم الفرز بنجاح وعندما اريد التعديل تظهر هذه المشكلة بالنسبة لزر تعذيل نعم هو لتعديل اليانات لليست بوكس وبيانات الشيت لكن لا اعرف كود يقوم بتعديل البيانات في اللست بوكس والشيت اليك الشرح بالصور

جربت ولم يفلح الامر تفضل المرفق ARCHIVE_1.rar

للعلم ان الكمبوبوكس 1 يبحث في العمود 2 والكمبوبوكس 2 يبحث في العمود 9

بارك الله فيك أستاذي فعلا هو المطلوب بقيت مشكلة واحدة هي عند البحث بواسطة الكمبوبوكس 2 عندما تريد التعديل لا يتم التعديل تظهر رسالة خطأ

أستاذي أبو البراء بارك الله فيك على الإضافة لكن عند التعديل تصبح جميع البيانات في الشيت عبارة عن قيمة انا أريد قيمة تكست بوكس3 هي التي تعدل For I = 1 To 8 O1.Cells(LI + 13, I + 1).Value = Val(Me.Controls("TextBox_" & I)) : Me.Controls("TextBox_" & I).Value = "" Next I قمت بتعديل على الكود نجحت العملية وانا اريدها بالحلقة التكرارية لإثراء معلوماتي O1.Cells(LI + 13, 2).Value = Me.TextBox_1.Value O1.Cells(LI + 13, 3).Value = Me.TextBox_2.Value O1.Cells(LI + 13, 4).Value = Val(Me.TextBox_3).Value O1.Cells(LI + 13, 5).Value = Me.TextBox_4.Value O1.Cells(LI + 13, 6).Value = Me.TextBox_5.Value O1.Cells(LI + 13, 7).Value = Me.TextBox_6.Value O1.Cells(LI + 13, 8).Value = Me.TextBox_7.Value O1.Cells(LI + 13, 9).Value = Me.TextBox_8.Value

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

شكرا أستاذي جربت الكود ولم يفلح تفضل الملف الاصلي ARCHIVE.rar

السلام عليكم ورحمة الله تعالى وبركاته حياكم الله أساتذتي الأفاضل إليكم الكود المرفق جيث يقوم بتعديل البيانات من تكست بوكس إلى الشيت علما ان الكود يقوم بتعديل البيانات من الصف الثاني وأنا أريد تعديل البيانات من الصف الخامس عشر Option Explicit Private Ws As Object Private Sub Modifier_Click() Dim LI As Integer Dim I As Byte Set Ws = Sheets("ARCHIVE") If Me.ListBox1.ListIndex = -1 Then Exit Sub LI = ListBox1.Column(0, ListBox1.ListIndex) For I = 1 To 7 O1.Cells(LI, I + 1).Value = Me.Controls("TextBox" & I): Me.Controls("TextBox" & I).Value = "" Next I End Sub مشكلة ثانية عنذ التعديل تظهر لي مشكلة تنسيق الأرقام رقم تم تخزينه كنص لأن في الشيث به البيانات عند التعديل تظهر هذه المشكله وفي الشيث توجد معاذلات لا تتعامل مع هذا المشكل الإ اذا قمت بالدخول للشيت وتحويل الى رقم

ربي يحفظك أستاذي تقبل الله صيامك كل عام وانت بالف خير

بارك الله فيك استاذي على الكود المقدم من طرفك جزاك الله كل الخير انا ايضا قمت بالتعديل على الكود الاول ولاثراء الموضوع اليكم الكود +اضافة الاحتواء التلقائي للنص داخل الخلية Sub format() Dim LastColumn As Integer Dim ws As Worksheet Dim Lastrow As Long Set ws = ThisWorkbook.Sheets(1) Application.ScreenUpdating = False LastCol = ws.Cells(15, ws.Columns.Count).End(xlToLeft).Column Lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row With ws.Range(Range("A15"), Cells(Lastrow, LastCol)) .Borders.LineStyle = xlContinuous .Font.Name = "Simplified Arabic" .Font.Size = 12 .VerticalAlignment = xlCenter .HorizontalAlignment = xlCenter For i = 1 To LastCol Columns(i).AutoFit Next End With Application.ScreenUpdating = True End Sub

قم بإشالة هذا السطر لا تظهر لك رسالة الخطأ 'Application.Undo Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If ActiveSheet.Name = "Log" Then Exit Sub Application.EnableEvents = False UserName = Environ("USERNAME") NewVal = Target.Value 'Application.Undo oldVal = Target.Value lr = Sheets("Log").Range("A" & Rows.Count).End(xlUp).Row + 1 Sheets("Log").Range("A" & lr) = Now Sheets("Log").Range("B" & lr) = ActiveSheet.Name Sheets("Log").Range("C" & lr) = Target.Address Sheets("Log").Range("D" & lr) = oldVal Sheets("Log").Range("E" & lr) = NewVal Sheets("Log").Range("F" & lr) = UserName Target = NewVal Application.EnableEvents = True End Sub

السلام عليكم ورحمة الله تعالى وبركاته اريد شرح للكود المرفق وجزاكم الله كل الخير أريد تنسيق تلقائي عن الكتابة في الخلية A15 نوع التنسيقات ( حدود - نوع خط - حجم خط ) كنت استمع هذا الكود النسخ واللصق للتنسيق Sub T1() Set Ws = ActiveSheet Ws.Range("A15:H15").Select Selection.Copy Lastrow = Cells(Rows.Count, "A").End(xlUp).Row - 1 Ws.Cells(Lastrow + 1, 1).Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Application.ScreenUpdating = True Ws.Range("A15").Select End Sub هذا الكود مطلوب شرحة والتعديل عليه ليفي بالغرض الذي طلبته Sub Findandformat() Dim LastColumn As Integer Dim ColumnLetter As String Dim ws As Worksheet Dim lr As Long Set ws = ThisWorkbook.Sheets(1) Application.ScreenUpdating = False If WorksheetFunction.CountA(Cells) > 0 Then LastColumn = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column If LastColumn > 26 Then ColumnLetter = Chr(Int((LastColumn - 1) / 26) + 64) & _ Chr(((LastColumn - 1) Mod 26) + 65) Else ColumnLetter = Chr(LastColumn + 64) End If End If lr = ws.Cells(Rows.Count, 1).End(xlUp).Row With ws.Range(Range("A1"), Range(ColumnLetter & lr)) .Borders.LineStyle = xlContinuous .Font.Name = "Simplified Arabic" .Font.Size = 14 .VerticalAlignment = xlCenter .HorizontalAlignment = xlCenter End With Application.ScreenUpdating = True End Sub

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

اين المرفق اخي لمساعدتك

جرب الشرح التالي

السلام عليكم ورحمة الله تعالى وبركاته تقبل الله صيامكم وقيامكم المطلوب في المرفق Gestion de Stock.rar

السلام عليكم فعلا هو المطلوب أستاذي الكريم جزاك الله كل الخير

اخي الكريم جربت ولم يفلح معي الامر

أرفع لي الملف الذي قمت بالتعديل عليه الذي بهكود الخاص بإظهار اليوزر واخفاء ملف الاكسل

فعلا هو المطلوب لكن وجهتني مشكلة بسيطة إن شاء الله أجد الحل عندك وهي انا الشيتات بأسماء مختلفة ياريت تعديل على هده المعادلة =SUM(data:data5!E2)

تفضل اخي فورمة ادخال.rar

تم إصلاح المشكل عند فتح الملف خصم من مخزون.rar

معذرة عن التأخير في الرد بسبب المشاغل تفضل لعله المطلوب بحث معدل1.rar