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

السلام عليكم سوف نشرح في هذا الموضوع طريقة سهلة جدا لإضافة 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

الشكر لله ثم لاخواننا واساتذتنا الذين تعلمنا ونتعلم منهم جزاهم الله خيرا وفيك بارك الله اخى تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق

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

وعليكم السلام اخى خلف انظر التعديل ده هل هو ما تريد اذا كان هو فجزاه الله خيرا اخى @Ali Sadiq فقد استفدت منه هذا الكود الجميل تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق تصفية_نموذج_مسافة.rar

تفضل أخي اليك التطبيق المثال تجربة قبول التكرار مع رسالة تحدير.rar

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

قبل اول كلمة Dim في الماكرو اكتب هذا السطر و بذلك يقوم الماكرو بعمله حتى ولو كانت الورقة محمية ActiveSheet.Protect "123", UserInterfaceOnly:=1 ليصبح الماكرو بهذا الشكل Option Explicit Sub get_my_studiants() Application.ScreenUpdating = False '++++++++++++++++++++++++++++++++++++++++++++++++++++++ ActiveSheet.Protect "123", UserInterfaceOnly:=1 '++++++++++++++++++++++++++++++++++++++++++++++++++++ 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 End With Exit_Sub: Application.ScreenUpdating = True End Sub الملف مرفق My_students_Protected.xlsm

أ / مصطفى كمال متولى لا شكر على واجب المهم أنه تم تنفيذ المطلوب بنجاح

محاولة منى جرب الكود =IF(B1="نصف";A1&"و "& B1;SUM(A1:B1)) إذا لم تشتغل المعادلة استبدل الفاصلة المنقوطة بفاصلة مرفق ملف جمع.xlsm

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

شكرا للاستاذ / احمد بدره اشكرا كثيرا

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

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

اللهم امين ولك مثله

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

و عليكم السلام و رحمة الله و بركاته هذا الاسم محجوز لعضو اخر لا يمكن استخدامه كاسم للدخول كما هو مذكور يمكنك تجربة اسماء اخري من اعدادت الحساب

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

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

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

ادخل دالة Nz في تلك العمليات

السلام عليكم انظر هل هذه النتيجة مرضية لك ووافنا بالنتائج تمنياتي بالتوفيق ادارة محل1.rar ملاحظة هامة صافي المبيعات = اجمالي المبيعات - مرتجع المبيعات (وليس + مرتجع المبيعات) فالكمية التي قام العملاء بارجاعها الينا يجب خصمها وليس اضافتها الي المبيعات وكذلك بالنسبة للمشتريات

وعليكم السلام ورحمة الله وبركاته في حدث عند الخروج حدد الحقل الذي يريد الانتقال اليه Private Sub aa_Exit(Cancel As Integer) DoCmd.GoToControl "d" End Sub او الانتقال الى سجل جديد Private Sub aa_Exit(Cancel As Integer) DoCmd.GoToRecord , , acNewRec End Sub تحياتي

كفكرة هل جربت nz

السلام عليكم جرب المعادلة التالية: * بالفرنسية : =ARRONDI.AU.MULTIPLE(8465.46;10) * بالإنجليزية : =MROUND(8465.46;10) ملاحظة : يجب أن تراعى الفاصلة المنقوطة والفاصلة في هذه المعادلات حسب النظام المعمول به...

جرب هذا الماكرو Option Explicit Sub ABSCENT() Application.Calculation = xlCalculationManual Dim K As Worksheet, A As Worksheet Dim Ro_K%, col%, Ro_A%, i%, m%, t%: t = 1 Dim ALL$, ALPHA$, Str$: Str = "غ" ALL$ = " ": ALPHA = " " Set K = Sheets("keab"): Set A = Sheets("arhkeab") Ro_K = K.Cells(Rows.Count, 2).End(3).Row If Ro_K < 5 Then Exit Sub Ro_A = A.Cells(Rows.Count, 2).End(3).Row m = IIf(Ro_A < 5, 5, Ro_A + 2) For i = 5 To Ro_K If Application.CountIf(K.Cells(i, 6).Resize(1, 31), Str) = 0 Then _ GoTo My_next A.Cells(m, 2).Resize(, 2).Value = _ K.Cells(i, 2).Resize(, 2).Value For col = 6 To 36 If K.Cells(i, col) = Str Then ALL = ALL & Day(K.Cells(4, col)) & "-" ALPHA = ALPHA & K.Cells(3, col) & "-" t = t + 1 End If Next col If t > 1 Then With A.Cells(m, 4) .Value = Mid(ALL, 1, Len(ALL) - 1) .Offset(, 1) = Mid(ALPHA, 1, Len(ALPHA) - 1) .Offset(, 2) = t - 1 .Offset(, 3) = K.Cells(2, "Q") .Offset(, 4) = Year(Date) End With m = m + 1 End If My_next: t = 1 ALL = " ": ALPHA = " " Next i Application.Calculation = xlCalculationAutomatic End Sub الملف مرفق Tarhil_3iyab.xlsm

تفضل هذا التعديل اخي الكريم تم اضافة تنسيقات شرطية حتما ستنال اعجابك اربعة الوان ابيض = ليس لديه اشتراك اخضر = لديه اشتراك اكثر من خمسة ايام ازرق = لديه اشتراك يساوي او اقل من خمسة ايام احمر = لديه اشتراك منتهي GYM.accdb

العامود 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

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

السلام عليكم اخي العزيز يوجد بالموقع الكثير من برامج الصادر والوارد / استخدم خاصية البحث هذا برنامج صادر ووارد للاخ / محمد علي الطيب وهو برنامج جميل جدا مفتوح المصدر تحياتي برنامج_الصادر_والوارد.rar

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

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

السلام عليكم و رحمة الله وبركاته اخي ولد مكة معذور على التأخير طبعا مكة الله يعمرها هذه الأيام زحمة لأبعد حد الله يعينكم ويتقبل منكم وكما ذكر اخي الحبيب مصطفى كمال الذي اعتبره انا واحد من كبار العارفين للتعامل بالدوال لا تستخدم الدالة dATEDIF هنا ولكن قم بعملية الطرح مباشرة = = = = و في المرفق قمت بعمل تعديل للتاريخ كـ التالي اذاكانت الغرفة بها تاريخ دخول و خروج - يحسب لك الأيام الى تاريخ الخروج اذاكانت الغرفة لها تاريخ دخول و ليس لها تاريخ خروج - يحسب لك الأيام حتى تاريخ اليوم اذاكان الغرفة ليس لها تاريخ دخول ولا تاريخ خروج يعطيك صفر شاهد المرفق ولدمكة.rar