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

قمت بتحديد النص وحولته الى 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

وعليكم السلام ورحمة الله وبركاته لم التزم بالفورم الذي ارفقته واقدم لك فورم يؤدى نفس المهمة شاشة دخول 123.xlsm

السلام عليكم ملفك به ارتباطات كثيرة بملفات اخرى وبه صيغ مرتبطة بملفات اخرى حاولت قدر الامكان حذف هذه الارتباطات الرسالة لم تعد تظهر بالنسبة لي جرب المرفق x s.xlsm

ركز معى قليلا اخي اولا - ملفك قمت بتجربتة واضفنا اكثر من صف ولم تأتي اي رسالة فملفك سليم ولا توجد مشكلة كما جربه استاذنا حسونة حسن واخبرك انه لا مشكلة في الملف ثانيا - الرسالة في وادى وملفك في واد اخر بمعنى الرسالة تتكلم عن مشكلة في محتوى الملف ‘1.xlsm وملفك هنا ليس بنفس الاسم ابحث في جهازك عن ملف باسم 1.xlsm وارفقه هنا في الموضوع فربما ملفك مرتبط بهذا الملف ولكي تتاكد جرب الملف على جهاز اخر لتتأكد من كلامنا موفق دائما

بعد اذن استاذنا الفاضل محمد هشام كذلك كود الاستاذ العلامة عبدالله باقشيرلا يتعامل مع اسماء اخرى مثل المعتصم بالله الواثق بالله ام كلثوم ام احمد ام الخير ام الهناء واحيانا بالهمز واحيانا لا وغيرها من الاسماء والقاعدة هي اظافة الاسم الثابت بمعنى مثلا فاطمة الزهراء فنضيف الى الكود الزهراء فقط لانه ثابت واي اسم ياتي قبل الزهراء سيتعامل معه الكود كذلك نور الهدى او سيف الهدى فنضيف الى الكود اسم الهدى فقط وهكذا كذلك يمكنك اظافة اي اسم اد جد اسم جديد تعديل الكود Function Father_Name(Name As String, Optional x As Integer = 2) As String Dim K As String Dim S As String Dim N As Integer Dim d As Integer Dim M As Integer Dim r As Integer K = Trim(Name) M = Len(K) S = " " If InStr(1, K, S, 1) = 0 Then Father_Name = "" Exit Function End If If x > 1 Then N = 1 For r = 2 To x d = InStr(N, K, S, 1) + 1 If d = 1 Then Father_Name = "" Exit Function End If N = d Next d = InStr(N, K, S, 1) + 1 If d = 1 Then Father_Name = "" Exit Function End If Father_Name = Mid(K, d, M) Else N = InStr(1, K, S, 1) + 1 d = InStr(N, K, S, 1) + 1 If d = 1 Then Father_Name = "" Exit Function End If If Mid(K, 1, 4) = "عبد " Or _ Mid(K, 1, 4) = "أبو " Or _ Mid(K, 1, 4) = "ابو " Or _ Mid(K, N, 5) = "الله " Or _ Mid(K, N, 6) = "الدين " Or _ Mid(K, 1, 5) = "الهدى " Or _ Mid(K, 1, 6) = "كلثوم " Or _ Mid(K, 1, 7) = "الزهراء " Or _ Mid(K, 1, 3) = "أم " Or _ Mid(K, 1, 2) = "ام " Or _ Mid(K, N, 5) = "بالله " Then Father_Name = Mid(K, d, M) Else Father_Name = Mid(K, N, M) End If End If End Function الملف استخراج اسم الاب من الاسم المركب1.xlsm

وعليكم السلام ورحمة الله وبركاته اتمنى ان يكون طلبك في هذا الملف test1.xlsm

الفكرة تم تطبيقها على ملف توزيع الطلاب.xlsb

هذه الرسالة تعني أن برنامج Excel وجد مشكلة في محتوى الملف ‘1.xlsm’ ويعرض عليك محاولة استعادة أكبر قدر ممكن من البيانات. هذا قد يحدث بسبب تلف في الملف أو مشكلة في البيانات المخزنة داخله. لحل هذه المشكلة، يمكنك اتباع الخطوات التالية: محاولة الاستعادة: اضغط على “Yes” عندما تظهر الرسالة للسماح لـ Excel بمحاولة إصلاح الملف. فتح الملف في وضع القراءة فقط: إذا لم تنجح المحاولة الأولى، حاول فتح الملف في وضع القراءة فقط ونقل المحتويات إلى ملف جديد.

وعليكم السلام ورحمة الله وبركاته اضغط زر بحث يمكنك الاختيار من القائمة ثم زر اظافة او الكتابة في المستطيل الاصفر وتتم الفلترة للاسماء سواء الاسم او اسم الاب او اللقب تم زر اظافة محرك بحث - قائمة منسدلة.xlsb

المعادلة =SUMPRODUCT(SUMIFS(RawMaterials!$C$2:$C$20; RawMaterials!$B$2:$B$20; ProductionMode!$B3:$B9); ProductionMode!C3:C9) الملف officena1.xlsb

السلام عليكم ورحمة الله وبركاته حسب وصفك للامر انت تحتاج الى كود ليقوم بالمهمة جرب واخبرنى بالنتيجة الكود Sub CalculateProductionCost() Dim wsRaw As Worksheet Dim wsProd As Worksheet Dim lastRowRaw As Long Dim lastRowProd As Long Dim i As Long, j As Long Dim materialName As String Dim materialCost As Variant Dim totalCost As Double Dim materialCosts As Object Dim prodValues As Variant Set wsRaw = ThisWorkbook.Sheets("RawMaterials") Set wsProd = ThisWorkbook.Sheets("ProductionMode") lastRowRaw = wsRaw.Cells(wsRaw.Rows.Count, "B").End(xlUp).Row lastRowProd = wsProd.Cells(wsProd.Rows.Count, "B").End(xlUp).Row Set materialCosts = CreateObject("Scripting.Dictionary") For i = 2 To lastRowRaw materialName = wsRaw.Cells(i, 2).Value materialCost = wsRaw.Cells(i, 3).Value If IsNumeric(materialCost) Then materialCosts(materialName) = materialCost End If Next i prodValues = wsProd.Range("B2:K9").Value For j = 3 To 11 totalCost = 0 For i = 1 To 8 materialName = prodValues(i, 1) If materialCosts.exists(materialName) And IsNumeric(prodValues(i, j - 1)) Then totalCost = totalCost + (prodValues(i, j - 1) * materialCosts(materialName)) End If Next i wsProd.Cells(12, j).Value = totalCost Next j End Sub الملف officena.xlsb

وعليكم السلام ورحمة الله وبركاته المعادلة التالية تتعامل في حالة اختلاف الصفوف =SUMPRODUCT((RawMaterials!$B$2:$B$20=INDEX(ProductionMode!$B$3:$B$9; ROW(ProductionMode!$B$3:$B$9)-ROW(ProductionMode!$B$3)+1))*(RawMaterials!$C$2:$C$20)*INDEX(ProductionMode!C3:C9; ROW(ProductionMode!C3:C9)-ROW(ProductionMode!C3)+1))

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

او هذا الكود تأكد من أن مكتبة DAO مفعلة في مشروعك. يمكنك تفعيلها من خلال الذهاب إلى Tools > References في محرر VBA، ثم التأكد من تفعيل Microsoft DAO 3.6 Object Library Private Sub Form_Open(Cancel As Integer) Dim tb As DAO.Recordset ' التأكد من استخدام DAO Recordset Set tb = CurrentDb.OpenRecordset("tbl_student1", dbOpenDynaset) tb.MoveFirst Do While Not tb.EOF tb.Edit ' وضع السجل في وضع التحرير tb.Fields("OnlyYou") = False ' تعديل قيمة الحقل tb.Update ' تحديث السجل في قاعدة البيانات tb.MoveNext ' الانتقال للسجل التالي Loop tb.Close ' إغلاق الكائن بعد الاستخدام Set tb = Nothing ' إلغاء الإشارة إلى الكائن End Sub

ان لم ينجح الامر جرب الكود التالي تأكد من أن مكتبة DAO مفعلة في مشروعك. يمكنك تفعيلها من خلال الذهاب إلى Tools > References في محرر VBA، ثم التأكد من تفعيل Microsoft DAO 3.6 Object Library Private Sub Form_Open(Cancel As Integer) Dim tb As DAO.Recordset Set tb = CurrentDb.OpenRecordset("tbl_student1", dbOpenDynaset) If Not tb.BOF And Not tb.EOF Then tb.MoveFirst Do While Not tb.EOF tb.Edit tb.Fields("OnlyYou").Value = False tb.Update tb.MoveNext Loop End If tb.Close Set tb = Nothing End Sub

الملف يشتغل معى جيدا على الاوفيس 2016 وليس لدي اوفيس 2003 لكي اجرب جرب الدخول References اي واحدة مؤشر عليها باسم MISSING الغ التاشير ثم موافق وكنصيحة حاول ترقية الاوفيس لديك الى اصدار احدث