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

جرب هذا ....... source.rar

وعليكم السلام .. جرب المرفق واعطنا النتائج تسجيل وقت الفتح.rar

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

عذرا اخت ياسمين حقيقة لم اقتنع بتخطيط البيانات للورقة ارى انها ليست لائقة . كما ان مشاركتك السابقة بالمخزون كانت محيرة تكررين نفس كميات المخزون لذلك تركت المجال لغيري لعله يفهم بياناتك يحبذ تنظيم البيانات في المرة القادمة . لقد قمت بتنظيمها بعض الشيء كما انه يوجد لديك خلايا مدمجة يجب الغاؤها حتى لا يتسبب مشاكل في الاكواد . اذا كنت مصرة على نفس التخطيط لبياناتك حينها اترك المجال لغيري ليقوم ما يلزم لضيق وقتي . Sub test() Dim findStr As String Dim i As Long, r As Long Dim sh1 As Worksheet, sh2 As Worksheet, Arr() Set sh1 = ThisWorkbook.Worksheets("Transaction") Set sh2 = ThisWorkbook.Worksheets("Receipt") With sh1 Arr = .Range(.Cells(2, 1), .Cells(LastRow(sh1), 11)).Value End With findStr = InputBox("Please Enter Receipt NO", "Receipt NO") sh2.Range("A7").CurrentRegion.ClearContents Application.ScreenUpdating = False With sh2 .Range("A6:D6").Value =Array("Date", "Description", "QTY", "Price USD", "Price LBP") For i = LBound(Arr) To UBound(Arr) If Arr(i, 11) = findStr Then r = LastRow(sh2) + 1 .Cells(r, 1) = Arr(i, 1) .Cells(r, 2) = Arr(i, 3) .Cells(r, 3) = Arr(i, 8) .Cells(r, 4) = Arr(i, 4) .Cells(r, 5) = Arr(i, 5) .Cells(4, 2).Value = findStr End If Next End With Application.ScreenUpdating = True End Sub Function LastRow(ByVal ws As Worksheet, Optional ByVal col As Variant = 1) As Long With ws LastRow = .Cells(.Rows.Count, col).End(xlUp).Row End With End Function Invoices-j3_03-officena.xlsm

حل على السريع حسب مقترح الاستاذ عبدالله يمكن استبدال الاستعلامات بجمل السيكوال..حسب رغبتك وحتى لاتكون هناك استعلامات كثيرة New Microsoft Access Database(3).rar

السلام عليكم ورحمة الله ..استبدل هذه العبارة MsgBox .Cells(r, 1) بهذه العبارة x = x & Chr(10) & .Cells(r, 1) و امسح هذه العبارة MsgBox .Cells(r, 1) و قم باولة العلامة من امام هذه العبارة MsgBox x

تم استاذنا شكرا مرة أخري

اذن بارك الله فيك عدل افضل اجابة

في هذا الفيديو شرح لعمل sort

انتبه من فضلك فهذا مخالف لمبادىء وقواعد المنتدى .. فهذه حقوق ملكية خاصة فقط بصاحب العمل .. فعليك بعمل اتصال مباشر به وطلب كلمة السر منه وشكراً لكم !!!

مثال للدوال systemUmAlQura.mdb

اخي الكريم لماذا لا تبحث في المنتدى اذا لم تجد تفاعل من الاعضاء حول موضوعك لا تعتمد كثيرا ان يقوم شخص بانشاء لك كود من الصفر (ابحث في المنتدى وقم بتطويع احد الاكواد بناء على احتياجاتك لان المنتدى تعليمي) جرب هذه المحاولة بالفلترة ( ملاحظة : اذا كانت البيانات ضخمة جدا عندها الفلترة تكون عديمة الجدوى) Sub FilterData() Dim startDate As Long, endDate As Long startDate = sheet2.Range("C2").Value endDate = sheet2.Range("C3").Value sheet2.Range("A6").CurrentRegion.ClearContents With sheet1.UsedRange .AutoFilter 1, ">=" & startDate, xlAnd, "<= " & endDate .SpecialCells(xlCellTypeVisible).Copy sheet2.[A6] .AutoFilter End With End Sub Search between two dates ‬.xlsm

تفضل أخي الكريم =IF($D5>=1*TEXT(TODAY();"dd");$D5-1*TEXT(TODAY();"dd");1*TEXT(EOMONTH(TODAY();1);"dd")-TEXT(TODAY();"dd")+$D5-1) موعد الرواتب (1).xlsx

تعديلات عديدة ممكن توضيحها في وقت آخر. الآن يمكنكم تبديل الأعمدة "العواميد" للفاتورة فقط دون مشاكل إن شاء الله ، أما عند تبديل أسماء الأعمدة فيجب عليكم تبديلها أيضا في الماكرو. موفقين. Invoices-j3_03.xlsm

اربطهم بجدول مؤقت تسجل فيه الفاتورة ثم عند الاضافة تنتقل البيانات الى جدول الفواتير ثم يتم افراغ الجدول المؤقت

السلام عليكم إخوتي الكرام بعد إذن الأخ الكريم الذي وصل إلى النتيجة ، إليكم طريقة أخرى بمعادلة واحدة فقط =IF(1*TEXT(EOMONTH(TODAY();0);"dd")>30;EOMONTH(TODAY();0)-4-TODAY()&"يوم";IF(1*TEXT(EOMONTH(TODAY();0);"dd")=30;EOMONTH(TODAY();0)-3-TODAY()&"يوم";IF(1*TEXT(EOMONTH(TODAY();0);"dd")=29;EOMONTH(TODAY();0)-2-TODAY()&"يوم";IF(1*TEXT(EOMONTH(TODAY();0);"dd")=28;EOMONTH(TODAY();0)-1-TODAY()&"يوم")))) وهناك معادلة أخرى فقط للملاحظة قد لا يحتاجها الأخ السائل: =" باقي"&$C$5&" "&"بناء على تاريخ نزول الراتب والذي يوافق يوم 27 من كل شهر ميلادي" والله ولي التوفيق ..والسلام عليكم موعد الرواتب.xlsx

وكذلك كود اخوي موسى بطريقتي : If Len(Me.nox & "") = 0 Then Exit Sub جعفر

وعليكم السلام 🙂 ان شاء الله طريقتي تعجبك 🙂 . . Private Sub VeiwReportBtn_Click() On Error GoTo Err_VeiwReportBtn_Click Dim qry_0 As String, qry_1 As String qry_0 = "Select * From qry_Table2_Empty_One_Record" qry_1 = "Select * From qry_Table2" DoCmd.DeleteObject acQuery, "tqry_SubReport" If DCount("*", "Table2", "T1ID=" & Me.IdCbo) = 0 Then CurrentDb.CreateQueryDef "tqry_SubReport", qry_0 Else CurrentDb.CreateQueryDef "tqry_SubReport", qry_1 End If Dim stDocName As String stDocName = "Report1" DoCmd.OpenReport stDocName, acViewPreview, , "[ID]=" & Me.IdCbo Exit_VeiwReportBtn_Click: Exit Sub Err_VeiwReportBtn_Click: If Err.Number = 7874 Then 'query tqry_SubReport does not exist, ignore Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If Resume Exit_VeiwReportBtn_Click End Sub جعفر 1523.ShowReportInNoDate.accdb.zip

طبعا أنا كنت أجرب قبل ما أشوف مشاركة أستاذنا العزيز جعفر 🙂 وهذي محاولتي : طبعا يتم استعراض ملفات ال PDF في المتصفح ( وهذا يتطلب وجود برنامج مشغل PDF ) ويمكن الاستغناء عن العرض الكود يجلب كل الملفات المرتبطة بالرقم المطلوب تلقائيا عند الإنتقال من سجل لآخر في النموذج الفرعي ويجمعها في ليست بوكس .. النقر المزدوج على اسم الملف يفتحه لك خارجيا .. وهذا الكود : Public Sub BringAllFilesAndFolders() Dim path As String, currentPath As String Dim List As ListBox Set List = Forms!tabl1!FileList path = CurrentProject.path & "\Datapdfx\" currentPath = Dir(path, vbDirectory) List.RowSource = "" Do Until currentPath = vbNullString If InStr(currentPath, CStr(Me.noid)) > 0 Then List.AddItem currentPath End If currentPath = Dir() Loop Set List = Nothing End Sub ربط البيانات مع ملف pdf.rar

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

مشاركة مع استاذنا @احمد الفلاحجي طريقة اخرى باستخدام عبارة not in لتكون جملة الاستعلام ⬇️ وهنا لسنا بحاجة الى عمل علاقة بين الجدولين في الاستعلام SELECT [2].[رقم العائلة] FROM 2 WHERE ((([2].[رقم العائلة]) Not In (SELECT [1].رقم FROM 1;))); الملف مرفق استعلام q_2 والعكس لو اردنا ان نحصل على السجلات المشتركة بين الجدول فقط نحذف عبارة not لتكون جملة الاستعلام ⬇️ SELECT [2].[رقم العائلة] FROM 2 WHERE ((([2].[رقم العائلة]) In (SELECT [1].رقم FROM 1;))); ملاحظة استخدام ارقام لاسماء الجداول ليست صحيحة تحياتي مثال_1.accdb

السلام عليكم أصدقاء المنتدى الكرام أقدم لكم ملف جاهز لتحويل التاريخ من الميلادى إلى التاريخ الهجرى ...أتمنى أن ينال إعجابكم بارك الله لكم جميعا برنامج تحويل التاريخ.xlsm