نجوم المشاركات

السلام عليكم سوف نشرح في هذا الموضوع طريقة سهلة جدا لإضافة QR CODE للتقرير داخل مربع نص و يدعم اللغة العربية كذلك أولا: هناك ملف تنفيذي يقوم بتسجيل الأدوات و نوع الخط نقوم بتثبيته داخل الكمبيوتر ثانيا: لإضافة QR CODE نقوم باستدعاء الوحدة النمطية الموجودة في المرفق في مصدر عنصر التحكم لمربع النص و نغير نوع الخط إلى BCW_2D =QrCode([T];1;1;صواب;4;1) [T]: هو مربع نص نأخذ منه البيانات و هذا رابط المصدر : https://barcodewiz.com/user-manual/qr-code-fonts/create_qr_code_barcodes_in_ms_access.aspx و أخيرا تمتع بـQR CODE رائع أرجوا من الإخوة تجربته و موافاتنا بالنتائج. توليد QR CODE.rar

وهل تتخيل وتتوقع انه يمكن العمل على التخمين ؟!!! فكيف تتم المساعدة بدون ملف مدعوم بشرح كافى ووافى عن المطلوب , مع وضع النتائج المرجوة فهذه المشاركة ما هي الا انها أدت لإهدار وقت الأساتذة بلا فائدة

بعد إذن الأستاذ مهند أولاً قم بالذهاب إلى المطور ثم اختر إدارج يظهر صندوق اختر منه مربع تحرير وسرد بعد ذلك قم بالضغط والسحب ليتم رسم الشكل قم بعمل كليك يمن على الشكل يظهر شكل اختر تنسيق عنصر تحكم اختر منه عنصر تحكم قم بإدخال النطاق ثم حدد ارتباط الخلية مرفق صورة للتوضيح 33.xls

ممكن نجربة هذا الكود اذا لم يكن هناك صفحة بأي اسم يقوم الماكرو باضافة صفحة جديدة بهذا الاسم و ينقل البيانات اليها Option Explicit Sub Add_sheet() Dim myname As Worksheet Dim P As Worksheet Dim sh_n%, k%, i% Set P = Sheets("اليوميه") sh_n = Application.CountA(P.Range("B:B")) - 1 Dim x%, t%: t = 2 Dim mn$ Application.ScreenUpdating = False ''''''''''''''''''''''''''''''''''''''''' For i = 2 To sh_n On Error Resume Next mn = Sheets(P.Range("b" & i) & "").Name x = Len(mn) If x = 0 Then P.Copy after:=Sheets(Sheets.Count) With ActiveSheet .Name = P.Range("b" & i) .Range("G14") = P.Range("F" & i) .Range("a1").CurrentRegion.Offset(1).ClearContents .Range("A:A").NumberFormat = ("dd- mm-yyy") For k = 2 To sh_n + 1 If P.Range("b" & k) = ActiveSheet.Name Then ActiveSheet.Cells(t, 1).Resize(, 4).Value = _ P.Range("A" & k).Resize(, 4).Value t = t + 1 End If Next End With '========================================= Else Set myname = Sheets(P.Range("b" & i) & "") myname.Range("a1").CurrentRegion.Offset(1).ClearContents For k = 2 To sh_n + 1 If P.Range("b" & k) = myname.Name Then myname.Cells(t, 1).Resize(, 4).Value = _ P.Range("A" & k).Resize(, 4).Value t = t + 1 End If Next '''''''''''''''''''''''''''''''''''' End If mn = "" Err.Number = 0 t = 2 Next i P.Select Application.ScreenUpdating = True End Sub الملف مرفق tarhil_by_names.xlsm

العفو أخي

ممكن تبدليه بهذا الكود Private Sub Worksheet_Selectionchange(ByVal Target As Range) If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select ElseIf Target.MergeCells = True And Target.HasFormula = True Then Target.Offset(0, 1).Select ElseIf ActiveCell.HasFormula = True And ActiveCell.MergeCells = True Then ActiveCell.Offset(0, 1).Select End If End Sub و بعذ إذن أستاذنا الفاضل سليم أرى أن يكون التعديل هكذا اكتب في السطر الذي قبل كلمة Dim في الماكرو ActiveSheet.Unprotect "123" واكتب في السطر الذي قبل كلمة End sub ActiveSheet.Protect "123" Option Explicit Sub get_my_studiants() Application.ScreenUpdating = False ActiveSheet.Unprotect "123" Dim A As Worksheet Dim B As Worksheet Set A = Sheets("ALL_STD") Set B = Sheets("B") Dim col%, r, x, LB LB = B.Cells(Rows.Count, "B").End(3).Row If LB < 5 Then LB = 5 B.Range("a5").Resize(LB - 4, 6).Clear Dim my_clas$: my_clas = B.Range("e2") Dim my_mad$: my_mad = B.Range("K2").Value If my_clas = "" Or my_mad = "" Then GoTo Exit_Sub col = A.Rows(1).Find(my_clas, lookat:=1).Column r = A.Columns(1).Find(my_mad, lookat:=1).Row x = Application.CountIf(A.Columns(1), my_mad) B.Range("b5").Resize(x).Value = _ A.Cells(r, 2).Resize(x).Value B.Range("c5").Resize(x, 3).Value = _ A.Cells(r, col).Resize(x, 3).Value With B.Range("A5").Resize(LB - 4, 6) .Columns(1).Formula = "=if(B5="""","""",max($A$4:a4)+1)" .Columns(1).Interior.ColorIndex = 6 .Borders.LineStyle = 1 .Columns(6).Formula = "=RANK(E5,$E$5:$E$29,0)+COUNTIF($E5:E$5,E5)" .Value = .Value .Font.Size = 26 .Font.Bold = True .InsertIndent 1 End With Exit_Sub: Application.ScreenUpdating = True ActiveSheet.Protect "123" End Sub My_students (1).xlsm

جزاكم الله كل خير

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

وعليكم السلام-تفضل لا يمكن الا بهذه الطريقة لا تترك رقم الوحدة فى اى صف فارغ تحصيل2.xlsm

وعليكم السلام ورحمة الله وبركاته ارفق مثال اخي الكريم لفهم المطلوب ولك الشكر تحياتي

تفضل اخي الكريم لاحظ مصدر combobox في النموذج والمعيار الموجود في الاستعلام Query1 w.rar تحياتي

تفضل أخي error.rar

انظر المرفق ..... لسرعة الاجابة حاولت تعديل حقول الجدول لديك .... Database1.mdb

بالتوفيق ....

جرب الكتابة داخل المربع الأول وانظر النتيجة .... ايقاف علامة جدولة.accdb

تفضل ....... Data.rar

اسف جدا كثرة الملفات علي .... انظر المرفق الجديد ..... تم تعديل المرفق .....اسف مرة أخرى QR_code_-name.mdb

نعم ممكن ولكن في حالة كثرة السجلات مثل مثالك يحتاج وقت وايضا كفاءة جهاز الكمبيوتر ..... انظر المرفق هذا ما تريد تم تعديل المرفق .... Desktop1.rar

بعض أسئلة الاستبيانات تكون ايجابية و الاخرى سلبية ، و فى حال رغبت فى اخذ متوسطات لاجابات محور معين يضم اسئلة سلبية و ايجابية ، يجب عكس النتائج الرقمية المناظرة لقيمة الرد، فمثلا الاصل فى حالة مقياس ليكارد الخماس أن تكون اجابة اتفق جدا = 5 و اتفق = 4 ، .... و هكذا ، فاذا كانت الاسئلة كلها ايجابية و هناك سؤال سلبي فهنا يجب تعديل القيم لاجابات هذا السؤال لتكون اتفق جدا = 1 ، اتفق = 2 ، ... قبل اجراء اية عمليات حسابية على المحور مثل حساب المتوسط مثلا. و اذا كان التفريغ يدويا فيمكن مراعاة ذلك ، اما فى حالة استخدام ادوات الكترونية لجمع الاستبيان فان الارقام تكون مسجلة بالفعل و يجب تعديلها ، و قد تكون العملية مرهقة فى حالة تعدد المتغيرات او كبر حجم العينة. و بالطبع يمكن تعديل الاسئلة لتكون فى نفس المحور ايجابية او سلبية ، و لكن فى بعض الاحيان يكون من الاسهل على مجيب الاستبيان الاجابة عن الصيغة الايجابية او السلبية بحسب المتعارف عليه في بعض مجالات التخصص ، فبصرف النظر عن صحة وجود اسئلة سلبية و ايجابية فى نفس المحور ، للقيام بعملية تعديل (عكس) نتائج عدد من الاجابات لتحويلها من ايجابية الي سلبية بصورة الية ، قمت باعداد دالة فى الاكسيل لتقوم بهذا الغرض (مرفق المثال). لنفرض ان الاجابات الاصلية كانت عن درجة الاتفاق مع كون وقت المشروع مناسب ، و اردتا تغيير الاجابات لتعبر عن كون زمن المشروع غير مناسب كما هو مبين: و ذلك عن طريق استخدام الدالة التالية: Function Reverse_Ordinal2(original_Ordinal As Byte) Dim newVal As Byte Select Case original_Ordinal Case Is = 1 newVal = 5 Case Is = 2 newVal = 4 Case Is = 3 newVal = 3 Case Is = 4 newVal = 2 Case Is = 5 newVal = 1 Case Else newVal = 0 End Select Reverse_Ordinal2 = newVal End Function مرفق المثال و لتشغيله يجب تفعيل الماكرو فى ملف الاكسيل و يتم ادراج الكود فى ملف اخر عن طريق فتح شاشة محرر البيزيك ALT+F11 ثم : السحب للملف الحديد او اختيار ادراج موديول جديد و نسخ الكود او استخدام الدالة و الملف المرفق مفتوح و اذا لم يكن لك خبرة بالتعامل مع الكود ، و لا ترغب فى ذلك ، يمكنك استخدام الملف المرفق مباشرة للتحويل و سحب أو نسخ الدالة للاسفل لتمتد لعدد الاسطر المطلوب ، مع مراعاة تفعيل الماكرو عند فتح الملف لتعمل الدالة ReverseOrdinalLekerd.xlsm

السلام عليكم ورحمة الله وبركاته 🙂 عندما يكون برنامج الاكسس يعمل ، وفجأة بدأ بإعطاء رسائل خطأ وبدون اي تعديل في البرنامج ، او عند عمل تعديل على البرنامج يُغلق الاكسس: . طريقة العمل: سيفتح البرنامج ، ويجب عليك غلقه ، الى ان لا يفتح تلقائيا مرة اخرى. ولكن ، يجب دائما اخذ الاحتياط وعمل نسخة من البرنامج قبل عمل هذه الخطوات. اقدم لكم شرح بسيط عن الموضوع: في الكثير من الاوقات ، لما نعمل الكود ، نقوم بتعديل وتغيير وتضبيط الكود عدة مرات ، ولكن الاكسس في بعض الاحيان يبقى محتفظ بالكود القديم في ذاكرته !! لذلك : 1. اثناء البرمجة ، وبشكل يومي اقوم بتشغيل هذا الملف المرفق ، 2. وقبل تسليم البرنامج الى الزبون ، اقوم بتشغيل الملف للمرة الاخيرة ، واجهز البرنامج لتسليمه الى الزبون وهذا هو الكود المعدل عن النسخة السابقة: Private Sub cmd_Decompile_Click() Dim MSAccPath As String Dim RegKey As String Dim WSHShell 'As Object Dim waitOnReturn As Boolean: waitOnReturn = True ' Get MSACCESS.exe directory from the Registry RegKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\" & _ "CurrentVersion\App Paths\MSACCESS.EXE\Path" Set WSHShell = CreateObject("WScript.Shell") ' Get parent directory MSAccPath = WSHShell.RegRead(RegKey) ' Decompile WSHShell.Run Chr(34) & MSAccPath & "MSACCESS.EXE" & Chr(34) & " " & Chr(34) & Me.str_File_Single & Chr(34) & " /decompile", , waitOnReturn ' compact WSHShell.Run Chr(34) & MSAccPath & "MSACCESS.EXE" & Chr(34) & " " & Chr(34) & Me.str_File_Single & Chr(34) & " /compact", , waitOnReturn ' cmd compile WSHShell.Run Chr(34) & MSAccPath & "MSACCESS.EXE" & Chr(34) & " " & Chr(34) & Me.str_File_Single & Chr(34) & " /cmd compile", , waitOnReturn ' compact WSHShell.Run Chr(34) & MSAccPath & "MSACCESS.EXE" & Chr(34) & " " & Chr(34) & Me.str_File_Single & Chr(34) & " /compact", , waitOnReturn ' Clear shell var Set WSHShell = Nothing End Sub جعفر Decompile_2.zip

شكراً لكم هو المطلوب بارك الله بجهودكم وزادكم من علمه

السلام عليكم ورحمة الله اخي الكريم أحمد الفلاحجى هههههههه لاشي بارك الله فيك اخي الكريم

مرحبا اخي احمد بدره هذا صحيح اخي وسليم 100% ولكن هل نستطيع تحقيق هذا الشرط بدون ظهور رسالة في غير محلها اعتقد لا في طريقتك الشق الاول وهو ( منع اللصق عند عدم تطابق القيم مع قيم القائمة المنسدلة ) يمنع اللصق مع رسالة بذلك وهذا سليم الشق الناني وهو ( السماح للصق عند تطابق القيم مع قيم القائمة المنسدلة ) يسمح باللصق ولكن مع اول كيليك في خلايا التحقق بعد السماح باللصق تطهر رسالة المنع وهي رسالة في غير محلها انظر الصورة بعد السماح للصق مع اول كليك في خلايا التحقق تحياتي اخي

الاخ emam1424 شاهد المرفقات Test_1.rar

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

بعد إذن أستاذنا الفاضل سليم لحماية المعادلات من العبث ممكن تضع هذا الكود في حدث ورقة العمل لمنع المستخدم من الوقوف على الخلية التي بها معادلة وبدون رقم سري جرب هذا Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select End If End Sub My_students (1).xlsm

مفيش مشكلة بالملف فالملف يعمل معى بكل كفاءة- شوف بنــفسك

انظر اخي الكريم للملف نفس الموضوع بدون وحدات نمطيه اتمنى ان يعمل عندك تحياتي images.rar

شكرا ً لأني عندما حاولت استبدالها لم تضبط معي في المرة الاولى ولجأت للدالة SUBSTITUTE REPLACE شاكر مرورك وحرصك وافادتك لي وتقبل تحياتي ولجيمع طاقم المنتدى

شاهد المرفق بدلا من الوقوف علي الرقم في العمود ( A ) اختار الرقم من القائمة في الخلية ( N1 ) والباقي كما طلبت تماما المرفق Tester.rar

السلام عليكم ورحمة الله استخدم الكود التالى بعد وضعه فى حدث ThisWorkBook دبل كليك على الخلية A1 فى كل مرة Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) If Target.Address <> "$A$1" Then Exit Sub On Error GoTo 1: For i = 1 To Sheets.Count If ActiveSheet.CodeName = Sheets(i).CodeName Then Sheets(i + 1).Activate Exit For End If Next 1: Exit Sub End Sub

اخي مهند لا شيء مستحيل مع برنامج اكسل هذه المعادلة في C5 واسحب نزولاً (يمكن تغير الرقم 7 الى ما تريد والنقطة الى ما تريد ايضاً مثلا * داخل الدالة REPT) =REPT(".",7)&VLOOKUP($I$1,ورقة1!$B$6:$E$27,ROWS($C$5:C5)+1,0)&REPT(".",7) الملف مرفق New_Book.xlsx

عندها يجب استبدال الكود الى هذا Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range) Dim x%, First As Range, y%, My_address$, Answer As Byte Application.EnableEvents = False If Not Intersect(sh.Columns(1), Target) Is Nothing Then Set First = Cells(Target.Row, 1) y = Application.CountIf(ActiveSheet.Columns(1), First) If y > 1 Then My_address = ActiveSheet.Columns(1).Find(First, lookat:=1).Address Answer = MsgBox("Error!" & Chr(10) & "This Record is Allready Exits in" & Chr(10) & _ " This Sheet cell:" & My_address & Chr(10) & "do you want to continue", vbYesNo) If Answer <> 6 Then Target = vbNullString GoTo Exit_me Else GoTo Exit_me End If End If For Each sh In Sheets If sh.Name = ActiveSheet.Name Then GoTo My_next: x = Application.CountIf(sh.Columns(1), First) If x > 0 Then My_address = sh.Columns(1).Find(First, lookat:=1).Address Answer = MsgBox("Error!" & Chr(10) & "This Record is Allready Exits in" & _ Chr(10) & sh.Name & ":" & My_address & Chr(10) & _ "do you want to continue", vbYesNo) If Answer <> 6 Then Target = vbNullString GoTo Exit_me End If GoTo Exit_me End If My_next: Next End If Exit_me: Application.EnableEvents = True End Sub الملف من جديد No Repeat In All Sheets_by_choise.xlsm

هل من الممكن يكون ان تظهر في الرساله نعم او لا في حالة الضغط على نعم لا يتم المسح واذا تم الضغط على لا يتم المسح ولك مني ارقى تحيه

هههه ... طيب الحمد لله رب العالمين

نعم أخي صدقت وصدق أستاذنا ومعلمنا أبوخليل قمت بالتعديل علي مرفق الأخ السائل وفقا لمراده رغم تحفظي علي طريقة العمل لعل لديه وجهة نظر لا نعلمها أما عن المرتجعات فبلغة المحاسبين هي قيد عكسي لعملية البيع أو الشراء بمعني: حساب المبيعات دائن بطبيعته (دائما يكون في الجانب الدائن) - فإن المرتجع المتعلق بالمبيعات لا بد أن يكون مدين وكذلك حساب المشتريات مدين بطبيعته (دائما يكون في الجانب المدين) - لذا لا بد أن تكون مرتجع المشتريات دائن وبلغة الأرقام فإن المعادلة لصافي المبيعات وصافي المشتريات تكون كالتالي: صافي المبيعات = اجمالي المبيعات - مرتجع المبيعات صافي المشتريات = اجمالي المشتريات - مرتجع المشتريات وهنا صورة لنموذج حـ/ المتاجرة الذي يوضح الفكرة بالأعلي

أخي RAGABFAROUK لطالما نصحنا أساتذتا بهذا المنتدي الكريم بتقسيم البرنامج الي واجهات وجداول أي تكون النماذج والاستعلامان والتقارير بقاعدة بيانات مستقلة وتكون الجداول بقاعدة أخري ويتم الربط بينهما -- تفاديا لمثل هذه المشكلات وكذلك الاحتفاظ بالنسخة الأصل قبل الحفظ بصيغة الــ ACCDE وكذلك أخذ نسخة أحتياطية من البرنامج كل فترة زمنية قريبة يخفف كثيرا من الاضرار الناجمة عن هذا العطل وفي النهاية أسأل الله أن يجيرك في مصابك ويخلف عليك خيرا منه وأرجو أن يكون المرفق به شئ مما ترجو الحصول عليه فهذا كل ما استطعت انقاظه لك DR_ELLABBAD_fixed.rar

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

انت فك التقرير بتاعك وشوف ......

العامود D اجعله فارغاً من كل شيء نفذذ هذا الماكرو Sub tarheel22() Dim myrange1 As Range Set myrange1 = Sheets("Sheet1").Range("E3:G4") Sheets("Sheet1").Range("a3").CurrentRegion.Clear Sheets("Mydata").Range("A3:C500").AdvancedFilter _ xlFilterCopy, myrange1, Sheets("Sheet1").[a3] End Sub الملف مرفق Salim_222.xlsb

حرب هذا الماكرو Option Explicit Sub get_my_studiants() Application.ScreenUpdating = False Dim A As Worksheet Dim B As Worksheet Set A = Sheets("ALL_STD") Set B = Sheets("B") Dim col%, r, x, LB LB = B.Cells(Rows.Count, "B").End(3).Row If LB < 5 Then LB = 5 B.Range("a5").Resize(LB - 4, 6).Clear Dim my_clas$: my_clas = B.Range("e2") Dim my_mad$: my_mad = B.Range("K2").Value If my_clas = "" Or my_mad = "" Then GoTo Exit_Sub col = A.Rows(1).Find(my_clas, lookat:=1).Column r = A.Columns(1).Find(my_mad, lookat:=1).Row x = Application.CountIf(A.Columns(1), my_mad) B.Range("b5").Resize(x).Value = _ A.Cells(r, 2).Resize(x).Value B.Range("c5").Resize(x, 3).Value = _ A.Cells(r, col).Resize(x, 3).Value With B.Range("A5").Resize(LB - 4, 6) .Columns(1).Formula = "=if(B5="""","""",max($A$4:a4)+1)" .Columns(1).Interior.ColorIndex = 6 .Borders.LineStyle = 1 .Columns(6).Formula = "=RANK(E5,$E$5:$E$29,0)+COUNTIF($E5:E$5,E5)" .Value = .Value .Font.Size = 26 .Font.Bold = True .InsertIndent 1 End With Exit_Sub: Application.ScreenUpdating = True End Sub الملف مرفق My_students.xlsm

لا أعلم اذا كان هذا المطلوب Tekrar.xlsx

اولا احب ان اشكر كل اعضاء و مشرفى هذا المنتدى العظيم الذى تعلمت و لازلت اتعلم منه الكثير و الكثير و اليوم اقدم الى الجميع برنامج المخزون الشامل حيث قد طلب منى احد الاصدقاء برنامج لضبط حركه مخزون شركته وهى شركه مستحضرات تجميل فقد قمت بعمل هذا البرنامج الذى يصلح لكل انواع المخزون مع بعض التعديلات البسيطه نبذه صغيره عن البرنامج 1-برنامج يحتوى على صفحه فواتير المبيعات و المشتريات و المرتجعات 2-و يحتوى على صفحه كشف حسب العملاء التى توضح المدفوع و المستحق خلال فترات معينه 3- صفحه التقارير وتضم حركه الاصناف حركه الفواتير وتقرير شامل بالمبيعات و المشتريات خلال اى فتره انت تحددها 4- كما يمكنك ادخال اى سند سواء كان صرف او قبض من خلال فورم ادخال السندات 5- حركه المخزون و التى توضح الربح و الخساره لكل صنف على حده و المزيد و المزيد من المزايا الاخرى التى سوف تكتشفها بنفسك ملاحظات تم عمل البرنامج على اكسيل2010 وتم تجربته بنجاح على اكسيل 2010 الرقم السرى للدخول الى البرنامج هو 123 وانصح جميع الاخوه الذين يجربون البرنامج ان يتم تجريبه على نفس الاصدار تجنبا لحدوث اى مشاكل تم رفع البرنامج على موقع الميديا فير حيث ان حجم البرنامج 2 ميجا بايت كما ارحب براى الاخوه و الخبراء فى البرنامج سواء كان نصيحه او نقد او معلومه جديده كما انوه باننى جاهز لاى استفسار او تعديل لهذا البرنامج لمن يريد على حسب طبيعه عمله و على حسب وفت فراغى و اخيرا اشكر كل اعضاء ومشرفى هذا الصرح العظيم الذى تعلمت منه التحميل من الرابط التالى http://www.mediafire.com/file/u34hp2c38h6slc7/برنامج المخزون الشامل.rar برنامج المخزون الشامل.rar

شاهد المرفق الكود Function RESULTA(rng As Range) As String Application.Volatile Dim c As Integer Dim r As Integer Dim str As String Dim subj As String c = rng.Column r = rng.Row subj = Cells(2, c - 3).Text str = "راسب في مادة " & subj & " " If Cells(r, c) = "غ" Then str = str & "بسبب غيابه في العملي و" If Cells(r, c + 1) = "غ" Then str = str & "بسبب غيابه في التحريري و" If Cells(r, c) < Cells(9, c) Then str = str & "لعدم حصوله علي ربع الدرجة في العملي و" If Cells(r, c + 1) < Cells(9, c + 1) Then str = str & "لعدم حصوله علي ربع الدرجة في التحريري و" If Cells(r, c + 2) < Cells(9, c + 2) Then str = str & "لعدم حصوله علي ربع الدرجة في الكلية و" str = Left(str, Len(str) - 2) If Len(str) < 20 Then str = "ناجح" RESULTA = str End Function المصنف1.xlsm

السلام عليكم ورحمة الله من المفروض أن تختار "تنسيق خلايا" ثم من خاصية محاذاة "أفقيا" نختار آخر خاصية من القائمة "توزيع" (على ما أعتقد لأني أقوم بالترجمة من الفرنسية)... المشكل الوحيد أن السطر الأول أيضا يقوم بتمديده على عرض الخلية.. تجد ذلك في الملف المرفق... بن علية حاجي 21-6-2017.rar

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

اتفضل كما تريد Picture (1).rar

اليك الحل Employee Data - 2015salim.rar

تفضل أستاذ حمدي .. يا بختك بموضوعك هذا حل آخر بالكود مشابه لحل الأستاذ الكبير أبو تراب (مع إمكانية أن يكون المدى مطاطي أي غير ثابت Dynamic) Distinct Validation List Across Columns.rar

كلام ناس كبار وما عليه أي غبار وعشان نكمل المشوار دي كمان فكرة في نفس الإطار وإن شاء الله ما يكونش فيها تكرار لما تفضلتم به يا أساتذة من روائع الأفكار وزمان علمونا إن التكرار كمان بيعلم الشطار ياربي احفظ علينا أخوتنا وثبت اقدامنا على هذا المسار مع حبي وتقديري أخوكم أبو عبدالله تعيين نطاقة الطباعة نهاية صفه بنص بالنطاق.rar