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

السلام عليكم أخي الكريم حسبما فهمت من طلبك أرجو أن يكون ما طلبت رسوم__2019_2020معدل.xlsx

بعد اذن استاذنا وجيه شرف الدين واثراء للموضوع اليك المرفق ولكن بكود VBA ادخل قيمة البحث في الخلية b1 test.xlsm

السلام عليكم 🙂 جاء على بالي ، اذا كلمة السر هي (او حتى اسم المستخدم فيه العلامة/الاشارة) : kl;'';lk لذا في الكود ، يجب تغيير كلمة السر مال الجدول ، بالاضافة الى تغيير كلمة السر التي تم ادخالها : 'chr(39)= ' 'chr(95)= _ u = Replace(Me.Texte1, Chr(39), Chr(95)) p = Replace(Me.Texte3, Chr(39), Chr(95)) myWhere = "Replace(login, chr(39), chr(95))='" & u & "'" myWhere = myWhere & " and" '<اهم شيء هو ترك مسافة في البداية قبل and myWhere = myWhere & " Replace(passe, chr(39), chr(95))='" & p & "'" '<اهم شيء هو ترك مسافة في البداية قبل passe Debug.Print myWhere جعفر

احدى هاتين المعادلتين (حسب اعدادات الجهاز عندك) =INDEX($A$1:$A$100,MATCH(D2,$A$2:$A$100,0)) Or =INDEX($A$1:$A$100;MATCH(D2;$A$2:$A$100;0))

اخبرتك هكذا Private Sub cmd_Preview_Report_Click() On Error GoTo err_cmd_Preview_Report_Click If Len(Me.[السنة] & "") = 0 Then MsgBox "رجاء ادخال السنه" Me.[السنة].SetFocus Exit Sub ElseIf Len(Me.[الشهر] & "") = 0 Then MsgBox "رجاء ادخال الشهر" Me.[الشهر].SetFocus Exit Sub End If Dim myWhere As String myWhere = "[السنة]='" & [السنة] & "'" myWhere = myWhere & " And" myWhere = myWhere & " [الشهر]='" & [الشهر] & "'" DoCmd.OpenReport "تقرير1", acViewPreview, , myWhere Exit_cmd_Preview_Report_Click: Exit Sub err_cmd_Preview_Report_Click: If Err.Number = 2501 Then 'no data, ignor Else MsgBox Err.Number & vbCrLf & Err.Description End If Resume Exit_cmd_Preview_Report_Click End Sub . ومع انت لم تقل هذا ، ولكني استنتجت انك تريد فتح التقرير للسجلات التي تخص الشهر والسنة 🙂 جعفر 1203.2020القائمة الفرعية.accdb.zip

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

وعليكم السلام 🙂 بعد الـ Beep والرسالة ، ضع هذا الكود : Me.ZTeacher = null Me.Zday = null Me.ZDate = null Me.ZProduct = null Me.ZA2= null Me.ZA3= null جعفر

اخي @husamwahab عجبني في الكود If Rs!k = 0 Then i = j i=j صراحة جديده ولم تدرس في البرمجة لكن والله فكره ومبسوط منها اوي اخي @mohamad dahleek هذه محاولة وباستعلام SELECT tgar.no_11, tgar.name_1, Nz(DSum("k","dfaat","no_b>" & DLast("no_b","dfaat","k=0 and t=" & [no_11]) & " and t=" & [no_11]),0) AS Expr1 FROM tgar; بالتوفيق

اخى @beLaL 100 كان عندك خطأ فى كتابه حقل [Da_te] =Nz(DSum("[am_re]";"Pu_inv";"[ty_pu]='بيع'" And "[Da_te]=#" & [Da_te] & "#")) بالتوفيق ان شاء الله 1.rar

عليك برفع ملف العمل ولكن اتفضل الملف لعله يفى بالغرض جلب بيانات من اكتر من شيت بناء على معطى معين متغير.xls

السلام عليكم 🙂 اخي فايز ، اذا اردت ان تسرعي انتباه احد الاعضاء ، بحيث يحصل العضو على رسالة ، فالطريقة هي : اكتب العلامة @ ومسافة ، وتكتب اسم العضو ، فترى الاسماء تأتيك ، ومنها تختار الاسم الصحيح. مثلا اذا اردت ان اذكرك: @فايز.. اما بالنسبة للكود ، ففيه خطأ ، والتعديل هو (السر في التعديل هو التنسيق ، فلما تعمل التنسيق مثل ما عملت انا ، بداية الامر ونهايته تكون واضحة) : Private Sub f1_Click() Dim X As String X = Me.ZTeacher2.Column(1) & ".pdf" If Len(Dir(CurrentProject.Path & "\" & X, vbDirectory)) <> 0 Then If MsgBox("هناك ملف محفوظ من قبل هل تريد استبداله", vbYesNo + vbDefaultButton2 + vbMsgBoxRight, "تنبيه") = vbNo Then DoCmd.CancelEvent Else DoCmd.OutputTo acOutputReport, "تقرير المصروفات فردي1", "PDFFormat(*.pdf)", CurrentProject.Path & "\" & X End If else DoCmd.OutputTo acOutputReport, "تقرير المصروفات فردي1", "PDFFormat(*.pdf)", CurrentProject.Path & "\" & X End If End Sub . اخي @Shivan Rekany طالت الغيبة ، والحمدلله شفنا لط طلّه 🙂 جعفر

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

أبسط طريقة لذلك هو تغيير خاصية الفورم RightToLeft وجعلها True بدلا من False كما بالصورة

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

وعليكم السلام 🙂 اما انا ، فأفضّل ان اقوم بكل شيء في الكود ، لأن عندي مساعة واسعة ومجال اكبر للعمل هناك 🙂 يمكنك حل المشكلة بطريقتين ، اولها بإصطياد رقم الخطأ ، ثم نعمل on error والثاني بفحص المتغير قبل دخوله في المعادلة: استعمل wzn2: G_to_K_w([units],[wzn]) وهاي الوحدة النمطية ماله Public Function G_to_K_w(u As String, w As Double) As Double 'convert Gram to Kilogram 'wzn if len(u & "")=0 then G_to_K_w =0 elseIf u = "جرام" Then G_to_K_w = w / 1000 Else G_to_K_w = w End If End Function . جعفر

السلام عليكم 🙂 برامج الاكسس ممكن ان يصيبها العطب corruption لعدة اسباب ، وبرامج تصليح العطب يجب ان تكون من ضمن مكتبة برامج المبرمج 🙂 يُعتبر برنامج DataNumen Access Repair من احد البرامج المهمة في اصلاح ملفات الاكسس المعطوبة ، والآن الشركة تعطي النسخة الاحدث 2.9 للإستعمال الشخصي الغير تجاري ، مجانا ، من موقعهم : https://www.datanumen.com/access-repair/ انزلته وجربته ، بس لاحظت ان البرنامج بطيء بالمقارنة مع بعض البرنامج الاخرى ، ولكن لا تنسى أنها نسخة مجانية (للإستعمال الشخصي الغير تجاري) 🙂 جعفر رجاء استعمل رابط الشركة حتى تنزل آخر نسخة هناك ، بينما ارفق هنا النسخة 3 (احتياطا ، اذا غيرت الشركة رأيها لاحقا والغت النسخة المجانية ، فتكون عندنا هنا النسخة المجانية 🙂 ) daccr.zip

السلام عليكم و رحمة الله تعالى و بركاته بعد أن أنهينا الشطر الأول الخاص بالتعامل مع الويب من الأكسس بإستخدام أداة WebBrowser و هذا رابط الموضوع: نبدأ الآن بحول الله تعالى في الشطر الثاني و هو التعامل مع صفحات الويب بدون إستخدام أداة WebBrowser سوف نستخدم في هذا الموضوع طريقتين الأولى التعامل المباشر مع المتصفح Internet Explorer و الثانية بإستخدام سرفر معين الجزء الأول: التعامل المباشر مع المتصفح Internet Explorer في هذا الجزء إن شاء الله سوف نقوم بفتح نسخة من المتصفح Internet Explorer و نرسل لها بيانات أو نستقبل منها. سوف نستخدم مثال الأخ @ابوآمنة للتطبيق عليه بإرسال بيانات لنموذج غوغل من خلال متصفح خارجي: هذا هو الكود: Dim HTMLDoc As HTMLDocument Dim oBrowser As InternetExplorer Dim oHTML_Element As IHTMLElement Dim sURL As String On Error GoTo Err_Clear sURL = "https://docs.google.com/forms/d/e/1FAIpQLSejrVMF2ucvGdzXefD7MeoKze4_8Fn-ir7dHmrAIwduHzBbtg/viewform" Set oBrowser = New InternetExplorer oBrowser.Silent = True oBrowser.Navigate sURL oBrowser.Visible = False Do ' Wait till the Browser is loaded Loop Until oBrowser.ReadyState = READYSTATE_COMPLETE Set HTMLDoc = oBrowser.Document HTMLDoc.getElementsByTagName("input").Item(0).Value = Me.n1 HTMLDoc.getElementsByTagName("input").Item(1).Value = Me.n2 HTMLDoc.getElementsByClassName("appsMaterialWizButtonPaperbuttonLabel quantumWizButtonPaperbuttonLabel exportLabel").Item(0).Click Do ' Wait till the Browser is loaded Loop Until oBrowser.LocationURL <> sURL oBrowser.Quit MsgBox "لقد تم إرسال البيانات بنجاح" Me.n1 = "" Me.n2 = "" Err_Clear: If Err <> 0 Then Err.Clear Resume Next End If شرح الكود: Dim HTMLDoc As HTMLDocument Dim oBrowser As InternetExplorer Dim oHTML_Element As IHTMLElement Dim sURL As String هنا قمنا بتعريف المتغيرات التي نحتاجها sURL = "https://docs.google.com/forms/d/e/1FAIpQLSejrVMF2ucvGdzXefD7MeoKze4_8Fn-ir7dHmrAIwduHzBbtg/viewform" هذا رابط الموقع Set oBrowser = New InternetExplorer إسناد نسخة من جديدة من Internet Explorer للمتغير oBrowser oBrowser.Silent = True oBrowser.Navigate sURL oBrowser.Visible = False السطر الأول هو إيقاف ظهور رسائل الأخطاء من المتصفح السطر الثاني تصفح الرابط sURL السطر الثالث التحكم في إظهاء أو إخفاء المتصفح أثناء العمل عليه Do ' Wait till the Browser is loaded Loop Until oBrowser.ReadyState = READYSTATE_COMPLETE الإنتظار إلى حين تحميل الصفحة HTMLDoc.getElementsByTagName("input").Item(0).Value = Me.n1 HTMLDoc.getElementsByTagName("input").Item(1).Value = Me.n2 إرسال قيم للمربع الأول و الثاني HTMLDoc.getElementsByClassName("appsMaterialWizButtonPaperbuttonLabel quantumWizButtonPaperbuttonLabel exportLabel").Item(0).Click الضغط على زر إرسال Do ' Wait till the Browser is loaded Loop Until oBrowser.LocationURL <> sURL إجراء حلقة دورانية لا يخرج منها إلا عند تغير رابط الصفحة و ذلك عند الضغط على زر الإرسال oBrowser.Quit إغلاق المتصفح بعد إرسال البيانات للتجربة افتح المرفق و ادخل بيانات في المربع الأول و المربع الثاني و اضغط على زر الإرسال و لاحظ ماذا يحدث و للإطلاع على ظهور النتائج ادخل على هذا الرابط: https://docs.google.com/spreadsheets/d/e/2PACX-1vSi73gAAIE9Rv8Ux43jjcvq9SSpzdVzs3M3ZEtehWqqP0pW4NLFLnkX3Iqoc9dYm_cx8vPz9S1465zd/pubhtml ارسال بيانات لنماذج غوغل.rar

السادة مرتادي المنتدى / السلام عليكم ورحمة الله مرفق ملف اكسل يتكون من 3 شيتات والمطلوب استخدام دالة داخل الشيت المسمى حركة الرسوم لتقوم بالاتي : عند ادخال رقم الطالب و اختيار جملة دين سابق من عمود البيان فيجب الا تظهر بيانات الرسوم المستحقة لهذه السنة . عند اختار جملة رسوم جديدة المطلوب ان تظهر بيانات الطالب مرة واحدة بمعنى لو تكرر ادخال اسم الطالب لفع باقي اقساط فيجب الا تظهر بيانات رسومه مرة اخرى. علما بان هناك محاولة لذلك داخل الشيت ولكم جزيل الشكر رسوم__2019_2020.xlsx

جزاك الله خيرا اخى حسام جزاك الله خيرا اخى رمهان بارك الله فيكم وزادكم الله من فضله وعلمه

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

@jjafferr @kha9009lid @أحمد الفلاحجى الحمد لله رب العالمين أساتذتي الفضلاء شكر الله لكم .. أصبحت الأمور على خير ما يرام ..

جرب المرفق واعتذر عن التاخير لضروف العمل Database110.rar

ربنا يكرمك استاذنا سليم حاصبيا هذا هو المطلوب بارك الله لك ولك كل الشكر والاحترام والتقدير من القلب اخيك ابوالحسن

لنفرض ان الرقم موجود في الخلية A1 جرب احدى هاتين المعادلتين (حسب اعدادات الجهاز عندك) =SUBSTITUTE(A1,"-","") Or =SUBSTITUTE(A1;"-";"")

اذا كنت تريد رقم الصف فقط =MATCH(D2,$A$1:$A$100,0) Or =MATCH(D2;$A$1:$A$100;0)

جرب المرفق وقبل الطباعة اخذف النسخة المحفوظة مسبقا A_Library1.rar

بعد التعديل انتهت المشكله لم اختبر المشكلة هل انتهت اخي احمد الان متوجه للعمل

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

يمكن خاف أقول ( عروسة ) تقبل الله منا ومنك بانتظارك

وعليكم السلام 🙂 استخدم هذا الكود قبل كود فتح التقرير : If Len(Me.[السنة] & "") = 0 Then MsgBox "رجاء ادخال السنه" Me.[السنة].SetFocus Exit Sub ElseIf Len(Me.user_name & "") = 0 Then MsgBox "رجاء ادخال الشهر" Me.user_name.SetFocus Exit Sub End If جعفر

السلام عليكم ارسلت لك رسالة على الخاص

اتفضل اخى فايز Private Sub f1_Click() Dim X As String X = Me.ZTeacher2.Column(1) & ".pdf" If Len(Dir(CurrentProject.Path & "\" & X, vbDirectory)) <> 0 Then If MsgBox("هناك ملف محفوظ من قبل هل تريد استبداله", vbYesNo + vbDefaultButton2 + vbMsgBoxRight, "تنبيه") = vbNo Then DoCmd.CancelEvent Else DoCmd.OutputTo acOutputReport, "تقرير المصروفات فردي1", "PDFFormat(*.pdf)", CurrentProject.Path & "\" & X End If End If End Sub بالتوفيق ان شاء الله

تفضل اخي لعله المطلوب العالمي 2020.xlsm

بارك الله فيك اخي احمد

بالخدمة اخي الكريم

جرب هذا الملف انه ينفذ الماكرو على الشيت التي تحتاره انت (في حال تحديد اكثر من شيت واحد) بواسطة رسالة تطلب منك رقم الشيت الذي تريده اما اذا كان شيت واحدة محددة فيقوم بتنفيذ الماكرو عليها Option Explicit Sub No_Error_In_Sheets() Dim ws As Worksheet, wb As Workbook Dim col As New Collection Dim i%, Inp_Box Set wb = ActiveWorkbook For Each ws In ActiveWindow.SelectedSheets i = i + 1 col.Add ws.Name, CStr(i) Next ws On Error Resume Next If i > 1 Then Inp_Box = InputBox("You Have More than One Selected Sheets" & Chr(10) & _ "Please Type The index Of the Sheet you need " & Chr(10) & _ "Example: " & "1,2,3,etc...", 1) Sheets(col(Inp_Box)).Select If Err.Number > 0 Then MsgBox "you select Wrong number: " & """" & Inp_Box & """" On Error GoTo 0 Exit Sub End If End If On Error GoTo 0 '++++++++++++++++++++++++++++++++ 'Type here your macro 'Example ActiveSheet.Range("a1:a10") = 100 '++++++++++++++++++++++++++++++ End Sub الملف للتجربة Run_macro.xlsm

أخي وحبيبي أبا جودى هل جربت هكذا units2: G_to_K_u(IIf(IsNull([units]);0;[units])) wzn2: G_to_K_w(IIf(IsNull([units]);0;[units]);IIf(IsNull([wzn]);0;[wzn]))

واهلا بك وجزاك الله كل خير

شاهد هذا الفيديو https://www.youtube.com/watch?v=gHN4yOOIrnE

مع ان الاستاذ @husamwahab وضع حل متميز عن طريق عمل استعلامين بعد انشاء علاقة رأس باطراف بين الجدولين والنتيجة متميزة ومن باب اثراء الموضوع وتعدد الحلول ممكن الوصول للنتيجة بدون اجراء اي تعديل وباستعلام واحد عن طريق دالة dsum بثلاثة معايير Nz(DSum("[total]";"كتب_الشكر";"[تاريخ_الكتاب]>" & Format([تاريخ اخر علاوة];"\#mm\/dd\/yyyy\#") & "And [تاريخ_الكتاب]<" & Format([تاريخ العلاوة القادمة];"\#mm\/dd\/yyyy\#") & "and [الاسم]='" & [الاسم] & "'");0) تفسير التعبير اجمع عدد كتب الشكر اذا كان تاريخ الكتاب اكبر من تاريح العلاوة وتاريخ الكتاب اصغر من تاريخ العلاوة القادمة واسم الموظف يساوي اسم الموظف وفي حالة عدم التطابق ضع العدد يساوي صفر ايضاح بسبب استخدام اسماء عربية للحقول لا يظهر الكود في المنتدى بشكل صحيح الملف مرفق Database910.accdb

السلام عليكم أخي الكريم يمكنك فعل ذلك باستخدام دالة CHOOSE للمساعدة في اختيار العمود بعد التحويل من نطاق إلى جدول كما هو موضح في الملف المرفق: تقبل تحياتي العطرة ...كما أرجو من أخي الكريم @Ali Mohamed Ali المعذرة لعدم اطلاعي على مشاركته إلا بعد عرضي للمشاركة معادلة vlookupحرة (1).xls

طبعا يمكن عمل هذا من خلال هذه المعادلة =VLOOKUP($A2,$M$7:$O$16,MATCH(B$1,$M$6:$O$6,0),0) معادلة vlookup1.xls

تفضل اخي العزيز ارجو ان يكون طلبك ملاحظة : تم عمل دالة يتم استدعائها عن طريق زر امر الناتج ويمكن استدعائها بالطريقة التي تحب Root250.rar

بعد اذن الأستاذ الرائد ولإثراء الموضوع تفضل Camtend(1).xlsm

اهلا بك فى المنتدى هناك عدة أكواد يمكنها عمل ذلك , عليك بإختيار الأنسب لك Public Sub PrintOneLine() Dim rng As Range For Each rng In Range(Range("A5"), Cells(Rows.Count, "A").End(xlUp)) With rng.Parent .PageSetup.PrintArea = rng.EntireRow.Address '.PrintOut 'remove the apostrophy .PrintPreview 'Add an appostrophy End With Next rng End Sub وثانى كود Sub PrintOneLine() Dim Rng As Range Dim WorkRng As Range Dim xWs As Worksheet On Error Resume Next xTitleId = "Officena" Set WorkRng = Application.Selection Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) Set xWs = WorkRng.Parent For Each Rng In WorkRng xWs.PageSetup.PrintArea = Rng.EntireRow.Address xWs.PrintPreview Next End Sub وهذا ثالث واخر كود Sub Printseprete() Dim c As Range For Each c In ActiveSheet.Range("A5:A105") ActiveSheet.PageSetup.PrintArea = c.EntireRow.Address ActiveSheet.PrintOut Next c End Sub Print.xlsm

اخي @mohamad dahleek تمام فهمت عليك ولكن بالنسبة ل او وجد الصفر اخر القائمة ولا يوجد بعده شي ؟ انت قلت نجمع مافوق الصفر .. وانا شايف انه يكون صفر لان الفكرة اعتقد هي تصفير ونقطة بداية .. فاكد علي هنا؟

وعليكم السلام-تفضل Middle East1(1).xlsx

وعليكم السلام الصور التالية هي من المرفق اعلاه: . . . وكما تلاحظ فالمجموع في ذيل التقرير يساوي مجموع التقارير الفرعيه ، حسب الرقم القومي ، والجمع صحيح استاذنا الفاضل ، دعني ارى ما تراه انت ، وعليه احاول ان اجاوب على سؤالك جعفر

206 عدد الطلاب الموجودة بالكشف يعني لو عدد الطلاب اصبح 350 طالب نكتب مكان ال206 نكتب 350 ولكن رأيت ان من الافضل ان تكون صفحة بيانات المدرسة هي الاساس في بعض البيانات وتم التعديل قليلا ليتم الاعتماد على عدد الطلاب من صفحة بيانات المدرسة كما بالمرفق استخراج حالة الطالب ومواد الرسوب معدل YASSER.rar

السلام عليكم ورحمة الله مفيد مفيد ولكن ارجو ان تشرح معادلات القصاصات وشكرا أخي الكريم قصي ماذا تريدني أن أشرح لك في معادلات القصاصات؟ الدالة المستعملة فيها هي الدالة VLOOKUP التي تبحث عن قيم من مجالات طولها 12 لهذا تجدني في هذه القصاصات قد استعملت هذه القيم من الشكل : 12*($A$2 - 1) + n حيث n تم تغييره من 1 إلى 12 وقيمة A2 المثبتة في الصيغة هي قيمة العدد في هذه الخلية (الخلية الملونة بالأصفر التي لا تدل على رقم القاعات مثلما نجد في ورقة قوائم القاعات)... مثال: لما تكون قيمة A2 هي 1 فإن لقيم التي تبحث عنها الدالة Vlookup هي من 1 إلى 12 وإذا كانت قيمة A2 هي 2 فإن القيم المطلوبة هي من 13 إلى 24 (الموالية حسب العدد الموجود في القاعات) وهكذا... وقد أضفت في هذه القصاصات رقمين بالأعلى يمثلان (رقم القاعة ورقم ترتيب الطالب في القائمة) مفصول بينهما بالرمز "-" حتى يكون ترتيبها سهل .... أرجو أني قد أجبت على طلبك... وإن كان هناك استفسار آخر تجدونني إن شاء الله في الخدمة دوما... ملاحظة: قد حضرت ملفا مشابها يعمل على إكسيل 2003 وإكسيل 2007 بإضافة شرط الإصدار Version قبل الطباعة (لسبب أن أمر الطباعة في إكسيل 2003 يختلف عن أمر الطباعة في إكسيل 2007)... وهذا حتى لا يجد إخواني الكرام أي مشكل في استعمال الملف في أي إصدار كان (المعمول بهما عادة). تجدون ذلك في الملف المرفق وأنتظر ملاحظاتكم على الملف... والله أعلم Listes_BAC_N.rar