حسونة حسين

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

وعليكم السلام ورحمة الله وبركاته قبل كلمه Function ضع Ptrsafe

وعليكم السلام ورحمة الله وبركاته الشكر لله اخى @Amr Ashraf الحمد لله الذي بنعمته تتم الصالحات

كيف اضبط Label مع رؤوس الاعمدة فى الليس بوكس

رؤوس الاعمده ابسط حاجه ممكن تعملها ب labels فوق الليست بوكس

اخي @Amr Ashraf جرب هذا التعديل Private Sub TextBox1_Change() Dim searchData As Range, Sh As Worksheet Dim Cell As Range Dim i As Long, A As Long Set Sh = ThisWorkbook.Worksheets("Data") 'Determine which search data to use based on radio buttons A = 0 Select Case True Case Process.Value = True Set searchData = ThisWorkbook.Worksheets("Data").Range("Data") ListBox1.ColumnWidths = "60,60,60" 'ColumnWidths of the ListBox1 Case Emp.Value = True Set searchData = ThisWorkbook.Worksheets("Data").Range("EmpData") ListBox1.ColumnWidths = "60,60,60,60,60" 'ColumnWidths of the ListBox1 Case Else 'No radio button is selected Exit Sub End Select ListBox1.Clear 'Clear the ListBox1 ListBox1.ColumnCount = searchData.Columns.Count ' ColumnCount of the ListBox1 If TextBox1.Value = "" Then Exit Sub 'Find matching values and add them to ListBox1 For Each Cell In searchData If InStr(1, Cell.Value, TextBox1.Value, vbTextCompare) > 0 Then ListBox1.AddItem For i = 0 To searchData.Columns.Count - 1 ListBox1.List(A, i) = Sh.Cells(Cell.Row, Cell.Column + i - 1).Value Next i A = A + 1 End If Next Cell 'Select the first item in the ListBox1 If ListBox1.ListCount > 0 Then ListBox1.Selected(0) = True End If End Sub هذا بالنسبه للإستفسار الاول

وعليكم السلام ورحمة الله وبركاته هنا تمت اضافه الكلمه التي تم البحث عنها فقط لابد من اضافه باقي الاعمده في الليست بوكس

وعليكم السلام ورحمه الله وبركاته تجميعه من البرامج الجاهزة

وجزاكم مثله اخى الحمد لله الذي بنعمته تتم الصالحات

وجزاكم مثله اخي جرب هذا التعديل Private Sub TextBox2_Change() If TextBox2 = "" Then AutoFilterMode = False Else Range("H1").AutoFilter , field:=8, Criteria1:=TextBox2.Text 'Right(TextBox2.Text, Len(TextBox2.Text)) & "*" Dim X X = Application.Match(Val(TextBox2), ورقة3.Columns(4), 0) If Not IsError(X) Then With ورقة3.Cells(X, "B") .Value = ورقة1.Cells(1, "I").Value .Interior.ColorIndex = 30 'From 1 to 56 لون الخلفيه .Font.ColorIndex = 20 'From 1 to 56 لون الخط End With End If End If End Sub

السلام عليكم ورحمة الله وبركاته وبها نبدأ Add2 عدلها الى Add في كل الكود وسوف يعمل معك على اوفيس ٢٠١٠

وعليكم السلام ورحمة الله وبركاته جرب هذا التعديل Private Sub TextBox2_Change() If TextBox2 = "" Then AutoFilterMode = False Else Range("H1").AutoFilter , field:=8, Criteria1:=TextBox2.Text 'Right(TextBox2.Text, Len(TextBox2.Text)) & "*" Dim X X = Application.Match(Val(TextBox2), ورقة3.Columns(4), 0) If Not IsError(X) Then ورقة3.Cells(X, "B").Value = ورقة1.Cells(1, "I").Value End If End Sub

يوجد ايضا هنا موضوع جميل شرح الماكرو و القوائم بالصور للاستاذ هادى محمد المامون سالم وهذه روابط كتب للاستاذ @nedal_shami باللغه العربية Excel 2019 2ed edition اكسيل 2013- المستوى المتقدم

يمكنك الاستفادة من هذا الموضوع

وعليكم السلام ورحمه الله وبركاته ارفق ملف به وليكن 50 بيان في الشيت رقم 1 و 100 بيان في الشيت رقم 2 ملف معبر عن ما تحتاج اليه حتي لا تضيع وقت الاخوة وتجد مبتغاك

وعليكم السلام ورحمه الله وبركاته اجعل الكود بهذا الشكل Sub Test() With Range("E5") .Value = Range("D5") / Range("C5") .NumberFormat = "0.0000%" End With End Sub

وعليكم السلام ورحمه الله وبركاته جرب هذا التعديل العملاء 2.xlsb

ويوجد هنا موضوع جميل للأستاذ @إبراهيم ابوليله لعلك تجد فيه ما تبغي

وعليكم السلام ورحمه الله وبركاته تفضل هذا كتاب Excel_2016__Power_Programming_with_VBA وهذا كتاب Excel_2019_Power_Programming_with_VBA الكتب باللغه الانجليزيه

وعليكم السلام ورحمة الله وبركاته تفضل رابط به مجموعه برامج جاهزه

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

وعليكم السلام ورحمه الله وبركاته تفضل هذا الكود ( تعديل لكودك ) Sub ترحيل_البيانات() Dim Lr As Long, SH As Worksheet, WS As Worksheet Set SH = ThisWorkbook.Worksheets("تقرير الوردية اليومي") Set WS = ThisWorkbook.Worksheets("شيت مجمع") Application.ScreenUpdating = False If MsgBox("انت تريد ترحيل هذا الايصال . هل تريد الاستمرار ؟", vbYesNo + vbQuestion) = vbNo Then Exit Sub End If If SH.Cells(4, 3).Value <> "" Then With SH .Activate .Unprotect Password:="011005051002018" WS.Unprotect Password:="011005051002018" If WS.FilterMode Then WS.ShowAllData End If Lr = WS.Cells(Rows.Count, "G").End(xlUp).Row + 1 WS.Range("A" & Lr).Resize(4) = .Range("C4").Value WS.Range("A" & Lr).Resize(4).NumberFormat = "dd/mm/yyyy" WS.Range("B" & Lr).Resize(4) = .Range("E4").Value WS.Range("C" & Lr).Resize(4) = .Range("G4").Value WS.Range("D" & Lr).Resize(4) = .Range("I4").Value WS.Range("E" & Lr).Resize(4) = .Range("K4").Value WS.Range("F" & Lr).Resize(4) = .Range("N4").Value .Range("B7:M10").Copy WS.Range("G" & WS.Cells(Rows.Count, "G").End(xlUp).Row + 1).PasteSpecial xlPasteValues .Range("B13:P16").Copy WS.Range("S" & WS.Cells(Rows.Count, "S").End(xlUp).Row + 1).PasteSpecial xlPasteValues .Range("C4,G4,I4,K4,N4,D7:J10,L7:P10,D13:I16,L13:P16").ClearContents .Protect Password:="011005051002018", AllowFiltering:=True, AllowFormattingCells:=True Application.Goto WS.Range("C4") WS.Protect Password:="011005051002018", AllowFiltering:=True, AllowFormattingCells:=True End With Else MsgBox "الرجاء وضع التاريخ و ملئ البيانات" SH.Activate SH.Range("C4").Select Exit Sub End If Application.ScreenUpdating = True End Sub

يا اخى كيف لا يهم شكل التقرير وكل الاكواد تعتمد علي شكل التقرير ( المخرجات )

وعليكم السلام ورحمه الله وبركاته استبدل هذا السطر Kh_Path = ThisWorkbook.Path & "\photo\" & p بهذا السطر Kh_Path = ThisWorkbook.Path & "\photo\" & 1 على اعتبار ان 1 هو اسم الصورة الخاصه بالشعار

وعليكم السلام ورحمه الله وبركاته لانها بتاريخ 18-1-2023 وفترة الإستحقاق 60 يوم ولو طرحت تاريخ اليوم من تاريخ الفاتورة سوف تجده انه 54 يوم كده الفاتورة لم تستحق فكيف تظهر في التقرير وكنت قد كتبت لك ولكنك اكتفيت ايضا بذياده اعمده وتشغيل الكود فقط ولم تضع شكل النتائج وذلك لان فاتورة العميل رقم 4 الجديده لم اجدها في التقرير وايضا لا يوجد سداد نقدي لاي فاتورة