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

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

تفضل على الرغم انك لم تقم برفع ملف مدعوم بشرح كافى عن المطلوب -فمن قوانين المنتدى لابد من رفع مثال لما تريد دائما فاتورة مبيعات وهذا ايضا فيديو شرح فاتورة الشراء والبيع وكيفية نقل الرقم من النموذج الى الجدول اكسس Access وهذا برنامج جاهز ايضا سوف يفيدك برنامج فواتير الشراء والبيع.rar

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

قبل اول كلمة 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

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

المشكلة لديك انت كما توقعت فيجب عليك تفعيل والتعليم على هذا الخيار ايضا وهو Trust Access

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

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

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

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

بعد إذن أستاذنا الفاضل عمر الحسيني يمكن عمل التحقق من الصحة الأرقام بين 0 و20 ممكن مسح البيانات الخطأ عن طريق التصفية ولكن عمود واحد فقط يعني عمود عمود كما بالصورة بعدها إظهار القيم الخطا قم بتحديدها ومسحها Test_2.xlsm

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

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

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

السلام عليكم ورحمة الله استخدم الكود التالى بعد وضعه فى حدث 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

ادخل دالة 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) ملاحظة : يجب أن تراعى الفاصلة المنقوطة والفاصلة في هذه المعادلات حسب النظام المعمول به...

حياك الله أخي @haniameen وبالتوفيق ...

جرب هذا الماكرو 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

السلام عليكم مرفق ملف يشرح داله subtotal subtotal.rar

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

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

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

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

السلام عليكم إخوتي الاحبه أعضاء وأساتذة منتدانا الغالي أقدم كود يقوم بالبحث في سلسلة نصيه ويستخرج ( الكلمات العربيه - والكلمات الانجليزي - والأرقام ) وكل سلسلة في عمود المدى الإفتراضي عمود "A" أرجو التجربه إن وجدت اي ملاحظات أو أخطاء Public Sub Cnvrt_Ali() Dim L_A&, i& On Error Resume Next ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\System32\vbscript.dll\3" On Error GoTo 0 With ActiveSheet L_A = .Cells(.Rows.Count, "A").End(xlUp).Row For i = 2 To L_A .Range("B" & i).Resize(1, 3).Value = S_Nm_Ali(.Range("A" & i).Value) Next i End With End Sub Private Function S_Nm_Ali(ByVal Nms As String) Dim E$, A$, Nm$ Dim V_r As Object Set V_r = CreateObject("VBScript.Regexp") On Error Resume Next With V_r .Global = True .IgnoreCase = True .Pattern = "\w|\n|\-|\(|\)|\&|\." A = Trim(.Replace(Nms, "")) .Pattern = "\D+" E = Trim(.Replace(Nms, "")) .Pattern = "[-?\d+(\.\d+)?|\u0600-\u06FF]" Nm = Trim(.Replace(Nms, "")) End With S_Nm_Ali = Array(A, E, Nm) Set V_r = Nothing End Function Ali_String.rar

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