عبدالله بشير عبدالله

تم التعديل يمكن الاختيار بالفارة ويمكنك الخروج عن طريق علامة × في الفورم test.xls

الاستاذ محمد هشام الفاضل / مبدع بجدارة صاحب الملف الفاضل/ جربت الملف زر الاظافة يعمل بدون اخطاء ا تحياتي لكما

اسعدنى ما قلت , بالتوفيق

السلام عليكم جرب المرفق الاختيار من القائمة بالضغط مرتين على العتصر المختار واذا كان الرقم غير موجود تاتى رسالة بذلك بالتوفيق واي ملاحظات لا حرج في ذلك test.xls

اين تريد النتائج في اي صفحة واي مدى

بالنسبة تكست 18 و19 اذهب الى لوحة التحكم - الساعة والمنطقة - المنطقة - ثم كما بالصورة الملف اظهار نتائج البحث في اللستبوكس1.xlsm

وعليكم السلام دالة recherchv لا اجيدها واعتقد انها فرنسية ولكن قمت بحل اخر وان لم يكن مناسبا لك قم بفتح موضوع جديد واطلب فيه دالة recherchv وستجد من الخبراء من يقوم بذلك تحياتي اسم المقاطعة.xlsb

السلام عليكم تم تعديل النقطتين الاولى والثانية والثانية كان سببها اكثر من رقم حساب مكرر النقطتان 3 4 ان شاء بعد العودة من العمل جرب المرفق ولاحرج في اي ملاحظة تقبل تحياتي اظهار نتائج البحث في اللستبوكس1.xlsm

وعليكم السلام ورحمة الله وبركاته معلمى واستاذي ابراهيم ابو ليلة / الجيل الذهبى للمنتدى ربما اشتركنا في المنتدى في نفس الفترة وعاصرنا عبدالله باقشير وملك المعادلات والدغيدى وعبدالله المجرب والشهابي وتعلمنا منهم الكثير وغيرهم الكثير , اشتراكى القديم في 2011 باسم عبدالله الصاري وتم ترقيتي الى الخبراء ومنذ سنتين لم اتمكن من الذخول الى المنتدى بسبب الدخول اصبح بالبريد الالكتروني والذي نسيته فاشتركت مجددا بلسم الحالى على كل حال اسعدنى تعليقك ولك وافر التقدير والاحترام

تعديل للملف اظهار نتائج البحث في اللستبوكس.xlsm

هو كود صغير يقوم بالمهمة وقبل الحذف يسالك هل تريد الحذف ام لا مع عدد من تم حذفهم الكود Sub DeleteRows() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim deleteCount As Long Dim response As VbMsgBoxResult Set ws = ThisWorkbook.Sheets("ورقة1") lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row deleteCount = 0 response = MsgBox("هل أنت متأكد أنك تريد حذف من استلمو الاول والثاني", vbYesNo + vbQuestion, "تأكيد الحذف") If response = vbYes Then For i = lastRow To 3 Step -1 If ws.Cells(i, 2).Value <> "" And ws.Cells(i, 3).Value <> "" Then ws.Rows(i).Delete deleteCount = deleteCount + 1 End If Next i MsgBox deleteCount & " صفوف تم حذفها.", vbInformation, "عملية الحذف" Else MsgBox "تم إلغاء عملية الحذف.", vbInformation, "إلغاء" End If End Sub الملف حذف اسماء من استلمو الاول والثاني.xlsm

وعليكم السلام لم اتمكن من تحميل الملف يستحسن اعادة رفعه مرة اخرى

قمت بطباعة الورقة وامورها 100% الاوفيس لدي 2016 وندوز 10 جرب على اكثر من جهاز

كما تشاهد في الصورة وافتح ملف PDF المرفق في مشاركتى السابقة الحدود متساوية بالكامل

السلام عليكم المعادلة =HYPERLINK("#'" & A2 & "'!A1"; A2) الملف ارتباط تشعبى شيت بخلية.xlsx

قمت بتحديد النص وحولته الى PDF لا توجد مشكلة ذ1.pdf

السلام عليكم اكتب الرقم في العمود F الكود Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim districtNumber As String Dim count As Integer Dim districtList As String Dim cell As Range Dim districtArray() As String Dim i As Integer Dim selectedDistrict As String Set ws = ThisWorkbook.Sheets("Feuil2") If Not Intersect(Target, ws.Range("F5:F" & ws.Cells(ws.Rows.count, "F").End(xlUp).Row)) Is Nothing Then districtNumber = CStr(Target.Value) If districtNumber <> "" Then count = Application.WorksheetFunction.CountIf(ws.Range("A2:A500"), districtNumber) If count > 1 Then districtList = "" For Each cell In ws.Range("A2:A" & ws.Cells(ws.Rows.count, "A").End(xlUp).Row) If cell.Value = districtNumber Then If districtList = "" Then districtList = ws.Cells(cell.Row, "B").Value Else districtList = districtList & "," & ws.Cells(cell.Row, "B").Value End If End If Next cell districtArray = Split(districtList, ",") With UserForm1.ListBox1 .Clear For i = LBound(districtArray) To UBound(districtArray) .AddItem districtArray(i) Next i End With UserForm1.Show If UserForm1.ListBox1.ListIndex <> -1 Then selectedDistrict = UserForm1.ListBox1.Value Else selectedDistrict = "" End If Target.Offset(0, 1).Value = selectedDistrict Else For Each cell In ws.Range("A2:A" & ws.Cells(ws.Rows.count, "A").End(xlUp).Row) If cell.Value = districtNumber Then Target.Offset(0, 1).Value = ws.Cells(cell.Row, "B").Value Exit For End If Next cell End If End If End If End Sub الملف اسم المقاطعة.xlsb

السلام عليكم / وصلت الفكرة ان شاء الله جرب الملف واخبرنى باي تعديل اظهار نتائج البحث في اللستبوكس.xlsm

بعد اذن استاذنا محمد صالح ومن خلال البحث في المنتدى =IF(ISNUMBER(FIND("."; Sheet1!A8)); VALUE(MID(Sheet1!A8; FIND("."; Sheet1!A8)+1; LEN(Sheet1!A8))); 0) =IF(ISNUMBER(FIND("."; Sheet1!A8)); VALUE(LEFT(Sheet1!A8; FIND("."; Sheet1!A8)-1)); VALUE(B8)) =MOD(SUM(A8:A12); 100) =SUM(B8:B12) + INT(SUM(A8:A12) / 100) الملف Book2.xlsx

حل رائع معلمنا حسونة حسين

السلام عليكم ورحمة الله وبركاته بعد اذن استاذنا ومعلمنا محمد هشام وحسب فهمى للطلب الكود Sub test() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim years As Long, months As Long, days As Long Dim totalMonths As Long Dim data As Variant Dim result() As Variant Application.ScreenUpdating = False Set ws = ThisWorkbook.Sheets("Sheet1") lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row data = ws.Range("A3:W" & lastRow).Value ReDim result(1 To UBound(data, 1), 1 To 1) For i = 1 To UBound(data, 1) If data(i, 2) = "" Then result(i, 1) = "" Else years = IIf(IsNumeric(data(i, 23)), data(i, 23), 0) months = IIf(IsNumeric(data(i, 22)), data(i, 22), 0) days = IIf(IsNumeric(data(i, 21)), data(i, 21), 0) totalMonths = (years * 12) + months + Int(days / 30) Select Case True Case data(i, 14) <> "" result(i, 1) = "كبير" Case data(i, 13) <> "" If totalMonths >= 12 Then result(i, 1) = "الاول أ" Else result(i, 1) = "الاول ب" End If Case data(i, 12) <> "" If totalMonths >= 36 Then result(i, 1) = "الثاني أ" Else result(i, 1) = "الثاني ب" End If Case data(i, 11) <> "" If totalMonths >= 72 Then result(i, 1) = "الثالث أ" ElseIf totalMonths >= 36 Then result(i, 1) = "الثالث ب" Else result(i, 1) = "الثالث ج" End If Case data(i, 10) <> "" If totalMonths >= 24 Then result(i, 1) = "الرابع أ" Else result(i, 1) = "الرابع ب" End If End Select End If Next i ws.Range("X3:X" & lastRow).Value = result Application.ScreenUpdating = True End Sub الملف تحويل من اجر اساسي الي اجر وظيفي (2).xlsb

السلام عليكم جرب الملف واخبرنى بالملاحظات لانى عملته بسرعة قبل الذهاب الى العمل ____برنامج المعطل ver 20 2024 مثال.xlsm

لم تظهر الرسالة كما كتبتها انت عند فتح الملف تظهر هذه الرسالة وعند الضغط على نعم تظهر هذه الشاشة وهي تظهر مربع حوار في برنامج Microsoft Excel يطلب من المستخدم الوصول إلى رابط SharePoint. ، ويحتوي الرسالة داخل المربع التي تخبر المستخدم بأنه مطلوب الوصول إلى رابط خارجي، والذي يبدو أنه عنوان URL لـ SharePoint يتعلق بالعمل أو التحكم في التكاليف. فاقوم باغلاق الشاسة فتظهر هذه الشاشة واستميحك عذرا بعدم قدرتي على ايجاد حل لملفك

تحياتي لك موفق دائما

وعليكم السلام ورحمة الله وبركاته نعم يمكن ذلك بواسطة كود عند الضغظ على الزر سيظهر صندوق يطلب فيه ادخال كلمة مرور ااصفحة 1 مثلا وهكذا الكود Sub ProtectSheetsWithDifferentPasswords() Dim ws As Worksheet Dim password As String For Each ws In ThisWorkbook.Worksheets password = InputBox("أدخل كلمة المرور للورقة: " & ws.Name) If password <> "" Then ws.Protect password:=password End If Next ws MsgBox "تم قفل جميع الأوراق بكلمات مرور مختلفة." End Sub مثال كلمة مرور مختلفة.xlsb