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

من خلال المنتدي الجميل عايز اوجه شكر للاخ العزيز د.كاف يار بالفعل هذا الرجل لا يتأخر عن طلب اي شئ طالما كان في استطاعته ودائما نستفيد منه جميعا وهو لا يبخل بأي معلومه وذلك عن تجربه شخصيه ربنا يجعله في ميزان حسناتك ويكرمك ويجعلك عونا لاخوانك يارب

التطبيق على مثالك في بداية الموضوع ..... اعلمنا بالنتيجة ..... ka_QR.rar

استخدم هذا الكود .... Dim I As Long Dim txtBuff As String Dim CheckChars As String CheckChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890 " Me.kanory.SetFocus txtBuff = kanory.Text For I = 1 To Len(CheckChars) txtBuff = Replace$(txtBuff, Mid$(CheckChars, I, 1), "") Next I If txtBuff = "" Then Me.kan1.Enabled = False Me.kan2.Enabled = True Else Me.kan2.Enabled = False Me.kan1.Enabled = True End If

ابحث في المنتدى عن طرق الحماية ..... تجد العديد والعديد من الطرق لذلك .....

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

شكرا لاستاذنا القدير حسام على المداخلة انظر المرفق انا بسطت لك العملية ، حيث حولت النموذج الى ادخال بيانات : نعم بمعنى انك سوف تدخل المعرف واسم المستخدم المهم ان الفكرة تصل ترقيم حسب المستخدم.rar

تفضل التعديل حسب توجيهات استاذنا الجليل ابو خليل اعادة الترقيم-1.rar

وعليكم السلام اخي الحبيب طلبك واضح ومفهوم .. اطلعت على المرفق ، واليك ملاحظاتي وهي خطوات يمكنك تطبيقها اولا : يجب ان يتم اختيار (او كتابة) معرف او يوزر المستخدم اولا .. فان كان موجود سيظهر اسمه ، وان كان جديد يلزم كتابة اسمه نأتي للترقيم : عند النقر على الزر يتم " عد " معرفات المستخدم الموجودة باستخدام : Dcount .. ويضاف لها واحد (+1)

يمكنك استعمال هذا الكود في حدث عند تغيير محتوي شيت الفاتورة Private Sub Worksheet_Change(ByVal Target As Range) Dim n As Long, r As Long, c As Long Dim sh As Worksheet: Set sh = Sheets("رصيد") If Target.Address = "$D$1" Then Range("b3:d16").ClearContents c = 2: r = 3 For n = 2 To sh.Cells(Rows.Count, 1).End(3).Row If sh.Range("b" & n) = Target Then Cells(r, c) = sh.Range("c" & n) r = IIf(c = 4, r + 1, r): c = IIf(c = 4, 2, c + 1) End If Next n 'MsgBox "Done by mr-mas.com" End If End Sub ولمن لا يعرف إضافة الكود في أحداث الصفحة كلك يمين على اسم الشيت ثم view code تقريبا بالعربي عرض التعليمات البرمجية ثم لصق الكود بالتوفيق

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

لا تحتاج إلى تغيير في المعادلة تحتاج إلى استعمال حلقة تكرارية for next for i = 10 to 1000 Range("R" & i ) = DateDiff("d", [K4], Range("K" & i )) next i بالتوفيق

الحل في حذف ما بعد acFormatPDF, وقبل , FALSE او true مع الحفاظ على الفاصلتين بالتوفيق

ما شاء اللّه الأمانة العلمية متوفرة جدا ولكن الحمد لله رغم تأخر نشري لهذا المجهود لي السبق موضوع منتدى الصقر : الدالة المعرفة JoinEA بديل للدالة TEXTJOIN بتاريخ 18-08-2018 10:05 مساء وموضوعي: مكتبة الموقع - بدائل دالة textjoin الموجودة في إكسل 2016 لجميع إصدارات اكسل mastextjoin بواسطة أ / محمد صالح, يناير 26, 2018 ربنا يصلح حالنا جميعا

شكرا للأمانة العلمية في نقل المعادلة المستخدمة هنا منذ أكثر من أربعة أعوام بدون ذكر صاحبها حينما قال صاحب الاستفسار أن المعادلة الأولى لم تعمل قمت بالرد في موضوعي بدائل دالة textjoin حتى يظهر له الحل بطريقة غير مباشرة بالتوفيق 🙄😏

I think your office version doesn't support TextJoin function so you can use UDF that is alternative to TextJoin. You will use the same formula exactly but replace the name of TextJoin with MyTextJoin Function MyTextJoin(break As String, ignore As Boolean, txt) As String Dim t, s$, i% For Each t In txt s = s & IIf(i = 0 Or (ignore = True And (s = "" Or t = "")), "", break) & t i = 1 Next t MyTextJoin = s End Function

الملف يعمل عندي بصورة طبيعية لذلك يجب التأكد من اختيار منطقة region عربية مثل Arabic(Egypt ) مثلا من لوحة التحكم control panel ---> الساعة والمنطقة clock and region ----> تغيير تنسيق التاريخ والوقت والأرقام change date, time, or number formats بعدها سيعمل بإذن الله بالتوفيق

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

هذا جزء من برنامجي ..... ka_stu.accdb

بارك الله فيك اخي الكريم ...... الحمد لله رب العالمين .... بالتوفيق

جرب المرفق ..... السبب في عدم الالحاق افتح الجدول A وازل الاشارات من كل السجلات ... AB.mdb

بارك الله فيك الاستعلام مكتوب كجملة SQL داخل الزر انظر الصور .....

طيب اخي الكريم جرب المرفق ووافينا بالنتيجة .... علما اننا اضفنا حقل نعم / لا في الجدول A AB.mdb

نظام اللمس يصلح للمطاعم والكافيهات اما البقالات والمتاجر فالذي يصلح لها هو نظام قارىء الباركود

اعرض الملف عمل نسخة تجريبية لمدة محددة بعدها التفعيل بسيريال خاص بكل جهاز بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته ------------------------ كل عام أنتم بخير وسعادة ورضا رمضان مبارك ================ استكمالا لسلسلة ما خف وزنه وغلا ثمنه موعدنا اليوم مع ملف يحتاجه كل مهتم بعمل نسخة تجريبية في الأكسس لمدة أسبوع أو شهر أو أي مدة تحددها في الكود ************************** ولا يطلب البرنامج التفعيل إلا بعد انتهاء المدة التجريبية وكذلك لا يجوز اللعب في تاريخ الجهاز لأنه سيتم اكتشافه /////////////////////////////////////////// مرفق ملفان واحد للبرنامج وملف لإنشاء السيريال للتجربة والاختبار واكتشاف الثغرات وهذا فيديو شرح الفكرة والكود +++++++++++++++++++++++++ ولا ينقصني سوى دعاؤكم لي بالخير في الدنيا والآخرة ********************** الكود يعمل على كل إصدارات الأوفيس لأنه تم عمله بأوفيس 2003 دمتم في رعاية الله وحفظه =-*/+=-*/+=-*/+=-*/+ إن شاء الله صاحب الملف أ / محمد صالح تمت الاضافه 07 يون, 2017 الاقسام قسم الأكسيس

Sub Test() With Sheet1 Sheet2.Range("C15").CurrentRegion.Offset(1).Clear .[J2].Formula = Replace("='#'!D3<>""""", "#", .Name) .[A2].CurrentRegion.AdvancedFilter 2, .[J1:J2], Sheet2.[C15:H15] .[J2].Clear End With End Sub

منتدانا الرائع به الكثير من الكنوز في هذا المجال تحتاج الغواص الجيد حتي يستكشفها https://www.officena.net/ib/search/?q=مواقيت الصلاة&quick=1&search_and_or=and بالتوفيق

حينما لا يكون أمامي جهاز كمبيوتر أقترح عليك اقتراحات ولكن الآن إليك الحل بفضل الله بتغيير الشرط إلى بداية الانصرف طرح الانصراف اكبر من صفر واقل من نصف انصراف مبكر: IIf([بدايه الانصراف]-[الانصراف]>0 and [بدايه الانصراف]-[الانصراف]<0.5,[بدايه الانصراف]-[الانصراف],0)*24 بالتوفيق

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

New Microsoft Access Database.accdb

اخي بارك الله فيك يجب ان تعطي الجداول حقها عند التصميم .. اعلم انه يجب ان يشتمل كل جدول على حقل فريد يكون هو مفتاح الجدول ، بمعنى يجب ان يشتمل كل جدول على مفتاح هذا المفتاح خاص بمحرك اكسس لزيادة ضبط وربط الجداول ، ليس للمشروع ولا للمبرمج دخل او علاقة فيه ، ومع ذلك يمكن للمبرمج الاستفادة منه كما هو الحاصل في مثالك انظر مثالك بعد التعديل AB (2).mdb

اضافة المثال سهل الاجابة ..... بارك الله فيك أخي @Eng.Qassim

تفضل جرب Nz(DSum("[Loan_Payment]", "[tbl_Loans]", "Format([Loan_AwardMonth],'yyyy') Like '*" & Me.txtYear & "*' And [Loan_Type] Like 'Cridi'"), 0)

الحمد لله ان تم المطلوب على خير وان فيه اى استفسار اتفضل

Sub SortData() Dim lr As Long lr = Range("E" & Rows.Count).End(xlUp).Row For Each Cell In ActiveSheet.Range("E7:E" & lr) Cell.Value = Application.WorksheetFunction.Trim(Cell.Value) Next Range("B7:S" & lr).Sort Key1:=Range("F7:F" & lr), Order1:=2, Key2:=Range("E7:E" & lr), Order2:=1, Header:=xlNo End Sub كود للفرز بمعيارين ولكن به اضافه مفيده وهي ازاله المسافات من بين الاسماء مما تعطي فرزا دقيقا للمحترم الغالي ياسر العربي

ما الذي لايعمل؟ يجب أن تحددكلامك فربما يفهما أحدنا أن الوظيفة الإضافية لا تعمل وهذا مخالف للحقيقة فهي تعمل بنجاح ربما يحتاج أحدنا ممن لم تعمل معه إعادة الخظوات بطريقة أكثر دقة في تنفيذ المطلوب وفقنا الله وإياكم لكل خير

كود اخر بواسطة Loop انتبه الى الملاحظات في اسفل الكود بواسطة هذه المعادلات لا تتأثر الخلايا في حال زيادة صفوف او حذف صفوف (قبل الصف 12)من الورقة أو اذا تم حذف اي اسم من لائحة الفصل لا يتأثر الترقيم في كلا العامودين اذا كنت قد فهمت الكود اليك هذا المهمة تنزيل كود اخر بحيث: 1-يعمل على المتغير I بواسطة Loop (من 1 الى 10) * عدد الفصول 2-يعمل على المتغير K بواسطة Loop (من 17 الى اخر صف في الورقة Main) * هذا الخاصية موجودة في الكود المرفق 3- يقوم بترقيم التلاميد بدون معادلات في العامودين I & C في كل ورقة من ورقات الصفوف Option Explicit Sub tanslate_data_salim_loop() Dim My_Sh As Worksheet Dim lr1, i, k, m, col, y As Integer Dim my_rg, cel As Range Application.ScreenUpdating = False Application.Calculation = xlCalculationManual lr1 = Main.Cells(Rows.Count, "c").End(3).Row Set my_rg = Main.Range("c17:g" & lr1) For i = 1 To 10 m = 0 Set My_Sh = Sheets(i & "") My_Sh.Range("d12:g36").ClearContents My_Sh.Range("i12:l36").ClearContents k = 17 Do Until k = lr1 + 1 'يمكنك استعمال هذا السطر ' Do While k <= lr1 'او هذا السطر Select Case m Case Is < 25 col = m + 12 y = 4 Case Else col = m - 13 y = 9 End Select If Main.Cells(k, "g") = i Then My_Sh.Cells(col, y).Resize(1, 4).Value = Main.Cells(k, 3).Resize(1, 4).Value m = m + 1 End If k = k + 1 Loop Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ملاحظات ' بالنسبة للمعادلات في صفحات الصفوف 'الافضل كتابة هذه المعادلة في الخلية 'C12: '=IF(D12="","",MAX($C$11:C11)+1) 'ثم اسحب نزولاً 'و هذه المعادلة في الخلية 'I12: '=IF(I12="","",MAX(C:C)+ROWS($A$1:A1)) 'ثم اسحب نزول '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

شكرا لجميع الإخوة المشاركين في الموضوع وللعلم تم تحديث المشاركة الأولى وتحديث الملف المرفق لتلافي بعض المشكلات برجاء إعادة تحميله

كما وعدت احبابي فيديو شرح كيفية استعمال الأداة الإضافية ولا ينقصني سوى دعاؤكم

برنامج لعمل قوائم الفصول ارجو ان ينال اعجابكم ط¨ط±ظ†ط§ظ…ط¬ ظ‚ظˆط§ط¦ظ… ط§ظ„ظپطµظˆظ„.rar

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

جزاك الله كل خير جعلها الله في ميزان حسناتك

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

الف شكر برنامج رائع كنت احتاج اليه كثيرا لفك الملفات للتعلم منها زادك الله علما ونفعنا به

ابدعت أخي محمد كما هي العادة في جميع مواضيعك : ) فلك الشكر والتقدير

رررررررررررررررررررررررررررررررراااااااااااااااااااااااائئئئئئئئععععععععععععععععععععععععععععععععععععععععععععععععع

جزاك الله كل خير و انعم عليك بعلمه الغزير و زادك ايمانا و علما

بارك الله فيك وجعلها الله في ميزان حسناتك وأرضى الله عليك والديك وإن شاء الله الفردوس الأعلى

جربت الطريقة وبصراحة كانت روعة جدا وناجحة

بعد التجربة لا يسعني إلا أن أشكرك جزيل الشكر فكرة رائعة

جزاك الله كل خير أخي محمد صالح