حسونة حسين

السلام عليكم ورحمه الله وبركاته
تفضل لعله طلبك
فقط النطاق المسمي Data تم تمديده  لحل مشكلتك
 
‏‏‏‏جديد 1.xlsm

السلام عليكم ورحمه الله وبركاته وبها نبدأ
جرب هذا التعديل اخى @mahmoud nasr alhasany
 
Gestion Stocks Magasin1.xlsm

تفضل اخى
الكود بطريقه ثانيه لعلها تكون المطلوبه
Private Sub TextBox2_Change() Application.OnTime Now() + TimeValue("00:00:02"), "ورقة1.test" End Sub Sub test() If TextBox2 = "" Then AutoFilterMode = False Else Range("H1").AutoFilter , field:=8, Criteria1:=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 .Font.ColorIndex = 20 End With End If End If End Sub  

السلام عليكم ورحمه الله وبركاته وبها نبدأ
تفضل اخى
باسسورد الدخول 123
 
نظام الحسامي للمخازن-123.xlsb

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة
و بصفة خاصة نؤكدعلى ما يلي
1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة
2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد.
3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال.
4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا.....
5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم.
ومخالفة ذلك تعرض الموضوع للحذف  
هذا الموضوع مخالف لقوانين المنتدي
××××××××
موضوع مكرر
××××××××
يغلق
××××××××

تفضل لان الخليه f3 بها تاريخ ظهر لك هذا الخطأ
sNewFilePath = ThisWorkbook.Path & "\" & Replace(Range("F3").text, "/", "-") & ".pdf"  

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة
و بصفة خاصة نؤكدعلى ما يلي
1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة
2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد.
3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال.
4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا.....
5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم.
ومخالفة ذلك تعرض الموضوع للحذف  
هذا الموضوع مخالف لقوانين المنتدي
××××××××
موضوع مكرر
××××××××
يغلق
××××××××

وعليكم السلام ورحمه الله وبركاته
جرب هذا التعديل
 
نموذج ادخال بيانات الحجاج داخل الشيت.xlsm

تفضل تبسيط للكود
 
نموذج ادخال بيانات الحجاج داخل الشيت.xlsm

جرب هذا التعديل على حسب فهمي
 
Sub Test() Dim Sh As Worksheet, Ws As Worksheet, i As Long, lr As Long, DestPath Set Sh = ThisWorkbook.Worksheets("School Fee Receipt") Set Ws = ThisWorkbook.Worksheets("Daily Report") lr = Application.Max(5, Ws.Cells(Rows.Count, "b").End(xlUp).Row) + 1 For i = 22 To 15 Step -1 If Sh.Cells(i, "H") <> 0 Then Ws.Range("B" & lr) = Sh.Range("E10") Ws.Range("C" & lr) = Sh.Range("E12") Ws.Range("D" & lr) = Sh.Range("e11") Ws.Range("E" & lr) = Format(Sh.Range("H9"), "[$-1010000]yyyy/mm/dd;@") Ws.Range("F" & lr) = Sh.Range("H10") Ws.Range("G" & lr) = Sh.Cells(i, "G") Ws.Range("H" & lr) = Sh.Cells(i, "H") Exit For End If Next i DestPath = ThisWorkbook.Path & "\" & Sh.Range("e11") & ".pdf" SH.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DestPath End Sub  

السلام عليكم ورحمة الله وبركاته وبها نبدأ 
تأكد من انه لا يوجد مشكله في اعدادات اللغه العربيه في الجهاز
لان الكود (الرئيسيه) ليس به مشكله 

وعليكم السلام ورحمه الله وبركاته
الكود ليس به مشكله اخى
انما المشكله في ادخال البيانات
تأكد من ان البيانات ليس بها خطأ
#DIV/0!
مثل هذه الصورة

وعليكم السلام ورحمه الله وبركاته
تفضل اخى
Private Sub CommandButton1_Click() Dim Ws As Worksheet, Arr, dic As Object, Levels, X Dim i As Long, R As Long, j As Long, P As Long Set Ws = ThisWorkbook.Worksheets("main") Arr = Ws.Range("A2:B" & Ws.Cells(Rows.Count, 1).End(xlUp).Row).Value Set dic = CreateObject("Scripting.Dictionary") R = 1 Levels = Array(TextBox1, TextBox2, TextBox3) Me.ListBox1.Clear ReDim B(1 To UBound(Arr, 1)) For i = LBound(Arr, 1) To UBound(Arr, 1) If Not dic.Exists(Arr(i, 1)) Then dic.Add Arr(i, 1), R B(R) = Arr(i, 1) & "-" & Split(Arr(i, 2))(0) R = R + 1 Else B(dic(Arr(i, 1))) = B(dic(Arr(i, 1))) & "-" & Split(Arr(i, 2))(0) End If Next i ReDim Tmp(1 To R - 1) For i = LBound(B, 1) To R - 1 If UBound(Split(B(i), "-")) = UBound(Levels) + 1 Then For j = 1 To UBound(Levels) + 1 X = Application.Match(Split(B(i), "-")(j), Levels, 0) If IsError(X) Then GoTo 1 Next j P = P + 1 Tmp(P) = Split(B(i), "-")(0) End If 1 Next i If P > 0 Then Me.ListBox1.List = Application.Index(Tmp, Evaluate("row(1:" & P & ")")) End Sub  
 
test.xlsm

وعليكم السلام ورحمة الله وبركاته 
ضع هذه المعادله في الخليه C6
ثم اسحب يسارا ونزولا لاسفل
 
مثال.xlsx

وعليكم السلام ورحمة الله وبركاته 
تفضل لعله لطلبك
 
الراتب الاساسى212 مارس.xlsx

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة
و بصفة خاصة نؤكدعلى ما يلي
1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة
2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد.
3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال.
4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا.....
5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم.
ومخالفة ذلك تعرض الموضوع للحذف  
هذا الموضوع مخالف لقوانين المنتدي
××××××××
موضوع مكرر.
××××××××
يغلق
××××××××
الإدارة

وعليكم السلام ورحمه الله وبركاته
تفضل اخى
Option Explicit Sub Search_Delete() Dim Arr As Variant, SH As Worksheet, dic As Object Dim I As Long, Unique_No As String, R As Range, P As Long Application.ScreenUpdating = False: Application.EnableEvents = False Set SH = ThisWorkbook.Worksheets("ورقة1") Arr = SH.Range("B2:F" & SH.Cells(Rows.Count, 2).End(xlUp).Row).Value Set dic = CreateObject("Scripting.Dictionary") dic.CompareMode = 1 For I = LBound(Arr) To UBound(Arr) Unique_No = Arr(I, 1) & Arr(I, 4) & Arr(I, 5) If Not dic.Exists(Unique_No) Then dic.Add Unique_No, P P = P + 1 Else If R Is Nothing Then Set R = SH.Cells(I + 1, 1) Else Set R = Union(R, SH.Cells(I + 1, 1)) End If End If Next I If Not R Is Nothing Then R.EntireRow.Delete Application.EnableEvents = True: Application.ScreenUpdating = True End Sub  
 

وعليكم السلام ورحمه الله وبركاته
جرب هذا التعديل
كود عمل فورمات للخلية عند التعديل.xlsm

وعليكم السلام ورحمه الله وبركاته
مبارك علينا وعليكم
تفضل
=VLOOKUP(A4,البيانات!$A$2:$E$8,MATCH($D$3,البيانات!$A$1:$E$1,0),0)  
معادلة على اساس رأس الجدول.xlsm

وعليكم السلام ورحمه الله وبركاته
تفضل اخي لعله طلبك ان شاء الله
 
التوزيعات بدون حماية.xlsm

وعليكم السلام ورحمة الله وبركاته 
تفضل اخى لعلها طلبك 
=ROUNDDOWN(L10/N10,0) & " " & L10-SUM(ROUNDDOWN(L10/N10,0)*N10) & "/" & N10  
 

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة
و بصفة خاصة نؤكدعلى ما يلي
1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة
2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد.
3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال.
4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا.....
5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم.
ومخالفة ذلك تعرض الموضوع للحذف  
هذا الموضوع مخالف لقوانين المنتدي
××××××××
انتهاك حقوق الملكيه
××××××××
يغلق
××××××××

وعليكم السلام ورحمه الله وبركاته
تفضل اخي هانى
 
 
Unique.xlsb

السلام عليكم ورحمه الله وبركاته وبها نبدأ
الملف ليس به اي بيانات وهو ايضا ليس بملف اوفيس
حاول تعمل ريكوفر باي برنامج ريكفر لعل وعسي تجد نسخه سليمة
هذا رابط برنامج 
Active Partition Recovery Professional 15.0.0 Portable
لعله يفيدك ان شاء الله

جزاكم الله خيرا اخى ابو يوسف @محمد حسن المحمد
جزاكم الله خيرا اخي @محمد يوسف ابو يوسف
جزاكم الله خيرا علي التنبيه
وهذا نص تقرير اخى ابو يوسف محمد حسن المحمد جزاه الله خيرا
السلام عليكم ورحمة الله وبركاته
إخوتي أساتذتي الكرام: تحية طيبة وبعد أرى أن هذا الموضوع وإن كان في ظاهره يخص سؤال أو أكثر في الإكسل،إلا أنه في حقيقة الأمر
يفتح باباً واسعاً لما لا يرضي الله وهو ما يخالف برأيي منهجنا كمسلمين
فقد ثبت عن النبي ﷺ أنه قال: من اقتبس شعبة من النجوم؛ فقد اقتبس شعبة من السحر، زاد ما زاد فتعلم التنجيم لمعرفة الحوادث، ودعوى علم الغيب هذا منكر عظيم
وإنما هي كما قال الله -جل وعلا- زينةٌ للسماء، ورجوم للشياطين، وعلامات يهتدى بها، فمن تعلمها لمعرفة الطرق، وأوقات الحراثة، وأشباه ذلك مما هو معروف؛ فهذا لا بأس به، أما أن يتعلمها لاعتقاد أنه بهذا يعلم الغيب، أو لأنها هي المحدثة للحوادث، فهذا كله خلاف منهجنا وديننا
والواجب على المؤمن أن يتقيد بالأمر الشرعي، وأن يحذر ما نهى الله عنه، والله يقول: قُل لَّا يَعْلَمُ مَن فِي السَّمَاوَاتِ وَالْأَرْضِ الْغَيْبَ إِلَّا اللَّهُ فالغيب عنده  وهو الذي يعلمه -جل وعلا- وليس عند المنجمين والسحرة والكهنة، ونحو ذلك ممن يدعون علم الغيب. جزاكم الله خيرًا.