أبو إبراهيم الغامدي

وعليكم السلام ورحمة الله طباعة الصورة بحجم الورقة يتسبب في تباعد نقاط الرسم وبالتالي تصبح الصورة مشوه المنظر. لهذا أنت بحاجة إلى تنسيق حجم الصورة قبل الطباعة.. طباعه المرفقات.accdb

وعليكم السلام رحمة الله أهلا بك @النجاشي أجريت تعديلا على بعض الإجراءات.. وأنشأت لك وظيفة تقوم بالبحث عن اسم الملف أبتداءً من الدليل الرئيسي إلى أدنى مستوىً من الأدلة الفرعية. فإن كان الملف موجودا؛ أعادة اسم الملف مع الدليل.. الوظيفة مع التعديلات Public Function XPath() XPath = CurrentProject.Path & "\src\" End Function Public Function FSO() As FileSystemObject Set FSO = New FileSystemObject End Function Public Function GetFileDirectory(MainPath As Object, Optional FileName As Variant) Dim OFIL As Scripting.File, OFILS As Scripting.Files Dim OMFD As Scripting.Folder, OSFD As Scripting.Folder Static XFileName As String, FilePath '.. Static Declaration reserved value when function recoll '-- get filename in first time call and reserved value If Not IsMissing(FileName) Then XFileName = FileName End If '-- loop for subfolders in his parent folder For Each OSFD In MainPath.SubFolders Set OMFD = FSO.GetFolder(OSFD.Path) Set OFILS = OSFD.Files '-- loop for file in each folder For Each OFIL In OFILS If OFIL.Name = XFileName Then FilePath = OFIL.Path GoTo TheEnd End If Next '-- Function recoll himself with subfolder GetFileDirectory OSFD Next TheEnd: '-- Function return filepath if file found GetFileDirectory = FilePath End Function اظهار المرفقات .zip

وعليكم السلام أ. غريب عوداً حميداً وأهلاً بك.. أتمنى أن أرى ابداعك بعد هذا الغياب..

https://get.adobe.com/reader/ عند التثبيت يظهر لك مربع حوار طلب الإذن باقتران أكروبات بمتصفح ويندوز.. وافق على الطلب

هذا التعديل يفي بالغرض إن شاء الله اظهار المرفقات .zip

لا.. لكن عليك الانتظار قليلا حتى يتم تحميل الملف في المتصفح.. خاصة إذا كان كبير الحجم

تأكد من أن الأكروبات ريدر محمل في جهازك

وعليكم السلام ورحمة الله وبركاته أهلا بك.. @ابو البشر مشاركة @محمد القدسي تملأ العين! ولكن إن أردت مشاكلة DLookup في الاستخدام فهذه هي الطريقة المناسبة في نظري.. (حقوق الحرفان الأوليان من الدالة محفوظة لـ أ.محمد القدسي) Public Function MqDLookup(Expr As String, DomainTable As String, DomainPath, Optional Criteria) On Error GoTo ArrCase '-- Dim DB As DAO.Database Dim RS As DAO.Recordset Dim W As Variant '-- test optional veriable If IsMissing(Criteria) Then W = W & "True=True" Else W = W & Criteria End If '-- Set DB = OpenDatabase(DomainPath) Set RS = DB.OpenRecordset( _ "Select " & Expr & " As Expr From " & DomainTable & " Where " & W) '-- MqDLookup = RS!Expr ExitFunction: Set DB = Nothing Set RS = Nothing Exit Function ArrCase: Select Case Err.Number Case 3061 MsgBox Err.Number & ": Expr Parameter Undefined", , "Developer Message" GoTo ExitFunction Case Else MsgBox Err.Number & ": " & Err.Description GoTo ExitFunction End Select End Function المثال التالي يمكن تطبيقه في النافذة السريعة لمحرر الشفرة ?MqDLookup("id_ciity&','&name_city","tbl_city",currentproject.Path & "\Adb_Dat.accdb","id_ciity=2")

وعليكم السلام ورحمة الله وبركاته.. في المثال المرفق استخدمت مستعرض الويب للتطبيق اظهار المرفقات .zip

أهلا بك.. لم تذكر الصيغة التي استخدمتها للتنقل بين السجلات! وفي الغالب أنك استخدمت الصيغة التقليدية.. كل ما يلزمك إضافة متصيد الأخطاء في السطر الأول من الإجراء، بهذه الطريقة.. On Error Resume Next Docmd.GoToRecord,, acNext أو استخدم الإجراء الموجود في المثال المرفق في جميع النماذج إن أردت Simple Navgation Buttoms .accdb

وعليكم السلام ورحمة الله وبركاته.. راجع هذه المشاركة قد تجد فيها ما يفيدك..

نعم هذا صحيح! لكن هناك إشكالات يرتكبها أحيانا مدخل البيانات النصية تتطلب إدخال النجمة عند البحث لتجاوز هذه الإشكالات! إليك بعض منها.. الأسماء المركبة: سعد الدين، .. ، وأمثالها كالأسماء المعبدة؛ والإشكال فيها أن مدخل البيانات قد يترك فراغا بين مقطع الاسم وقد لا يفعل.. وهنا يكون دور النجمة هو رفع هذا الإشكال! الأسماء المنسوبة: فلان بن فلان، فلانة بنت فلان..، - هذا مشهور في السعودية -، ولرفع الإشكال نستخدم النجمة! المتوقع أن يقوم بإدخال قيم الحقلين معاً

وعليكم السلام ورحمة الله أهلا أ. @عبد الله قدور بالنسبة لي مع دوال التجميع أفضل دمج أعمدة البحث مع استعمال المعامل ()Like بالطريقة التالية Dim Result Result=DlookUP("[Your Field]","[Your Table],"[Field One]&[Field Two] Like '*" & [Text One]&[Text Two] & "*'") Or Result=DlookUP("[Your Field]","[Your Table],"[Field One]&[Field Two] Like '*" & [Your Text] & "*'") :: تستطيع التعويض عن جزء البيانات بعلامة النجمة أو علامة الاستفهام

وعليكم السلام ورحمة الله وبركاته أهلا @محمد احمد لطفى Sub FillWebData() On Error Resume Next Dim F As HTMLFormElement Set F = WD.Forms("aspnetform") F("ctl00$Main$txtMain").Value = Me.Parent("حساب") F("ctl00$Main$txtName").Value = Me.Parent("الاسم") If WD.querySelectorAll("#ctl00_HeadContent_handasa > option").Length = 0 Then F("ctl00_HeadContent_governmentCMB").Value = "1" F("ctl00_HeadContent_governmentCMB").OnChange End If F("ctl00$Main$txtCurrentRead").Value = Me("حالية") F("ctl00$Main$txtDay").Value = Me.Parent("يومية") F("ctl00$Main$txtNationalID").Value = Me.Parent("IDPerson") F("ctl00$Main$txtManteka").Value = Me.Parent("منطقة") F("ctl00$Main$txtFary").Value = Me.Parent("فرعى") F("ctl00$Main$txtPhone").Value = Me.Parent("mobile") F("ctl00$Main$txtEmail").Value = Me.Parent("email") ' ctl00$HeadContent$tel '-- Solution of handasa field Do Until SetValue(WD, "461"): DoEvents: Loop '----------------------------- End Sub Sub DisplayFatorah() On Error Resume Next Dim F As HTMLFormElement Set F = WD1.Forms("aspnetform") F("ctl00_HeadContent_DropDownList2").Value = "1" If WD1.querySelectorAll("#ctl00_HeadContent_DropDownList1 > option").Length = 0 Then F("ctl00_HeadContent_governmentCMB").Value = "1" F("ctl00_HeadContent_governmentCMB").OnChange End If F("ctl00$Main$txtManteka").Value = Me.Parent("منطقة") F("ctl00$Main$txtDay").Value = Me.Parent("يومية") F("ctl00$Main$txtMain").Value = Me.Parent("حساب") F("ctl00$Main$txtFary").Value = Me.Parent("فرعى") '-- Solution of handasa field Do Until SetValue(WD1, "461"): DoEvents: Loop '----------------------------- End Sub غير اسم النموذج في كلا الإجرائين إلى Forms("form1") بدلا من Forms("aspnetform")

مبارك عليك أبو أحمد..

لا.. يمكنك تغيير اسم النموذج إلا إذا كان مغلقاً.. استخدم عوضاً عن ذلك Screen.ActiveForm

للتذكير فقط .. سهلة! finish (5).mdb

صدقت! لأن هناك حالتين في الشريحة الثالثة لم أقوم بإدراجها! والتي أشرتَ إليها واحدة منها.. والأخيرة أن تكون الحالة أصغر من بداية الفترة وأكبر من نهاية الفترة.. بمعنى أنها مفتوحة الطرفين.. وهذه لا أتوقع حدوثها لأن نهاية الفترة الثالثة 2050! finish (5).mdb

لأن بداية الفترة الثالثة في المثال تبدأ من 1-10-2020 وليست 30-9-2020! قم بتغييرها حسب متطلباتك

عزيزي @محمد احمد لطفى القيم السالبة ناتجة عن الاشتراطات المتعارضة بين الشرائج، وأتوقع وجود المزيد منها مع تنوع الإدخالات! يمكن معالجة هذا القصور باستخدام عبارة ()IIF كما في الحالات السابقة.. finish .mdb

آسف على هذا القصور.. هناك حالة لم أقوم بعالجتها في الشريحة الألى.. Option Compare Database Option Explicit Public Const SP1 = #1/1/1990# Public Const EP1 = #9/6/2016# Public Const SP2 = #9/7/2016# Public Const EP2 = #9/30/2020# Public Const SP3 = #9/30/2020# Public Const EP3 = #1/1/2050# Public Function DatePeriod(StartDate, EndDate, Interval) Dim Periods(1 To 3) As Variant If (StartDate >= SP1) And (EndDate <= EP1) Then Periods(1) = DateDiff("w", StartDate, EndDate) ElseIf (StartDate < SP1) And (EndDate <= EP1) Then Periods(1) = DateDiff("w", SP1, EndDate) ElseIf (StartDate < SP1) And (EndDate > EP1) Then Periods(1) = Abs(DateDiff("w", SP1, EP1)) ElseIf (StartDate >= SP1) And (EndDate > EP1) Then Periods(1) = IIf(DateDiff("w", StartDate, EP1) < 0, 0, DateDiff("w", StartDate, EP1)) Else Periods(1) = 0 End If If (StartDate >= SP2) And (EndDate <= EP2) Then Periods(2) = DateDiff("m", StartDate, EndDate) ElseIf (StartDate < SP2) And (EndDate <= EP2) Then Periods(2) = DateDiff("m", SP2, EndDate) ElseIf (StartDate < SP2) And (EndDate > EP2) Then Periods(2) = DateDiff("m", SP2, EP2) ElseIf (StartDate >= SP2) And (EndDate > EP2) Then Periods(2) = DateDiff("m", StartDate, EP2) Else Periods(2) = 0 End If If (StartDate >= SP3) And (EndDate <= EP3) Then Periods(3) = DateDiff("m", StartDate, EndDate) ElseIf (StartDate >= SP3) And (EndDate > EP3) Then Periods(3) = DateDiff("m", StartDate, EP3) Else Periods(3) = 0 End If DatePeriod = Periods(Interval) End Function finish .mdb أرجو التأكد من صحة البيانات مع مزيد من الإدخالات حتى يتسنى مععالجتها

أهلا محمد... أعتذر منك لأني لم استجب لنداءك قمت بالتوفيق بين أفكار الزملاء بالحل المرفق.. Option Compare Database Option Explicit Public Const SP1 = #1/1/1990# Public Const EP1 = #9/6/2016# Public Const SP2 = #9/7/2016# Public Const EP2 = #9/30/2020# Public Const SP3 = #9/30/2020# Public Const EP3 = #1/1/2050# Public Function DatePeriod(StartDate, EndDate, Interval) Dim Periods(1 To 3) As Variant If (StartDate >= SP1) And (EndDate <= EP1) Then Periods(1) = DateDiff("w", StartDate, EndDate) ElseIf (StartDate < SP1) And (EndDate <= EP1) Then Periods(1) = DateDiff("w", SP1, EndDate) ElseIf (StartDate < SP1) And (EndDate > EP1) Then Periods(1) = DateDiff("w", SP1, EP1) Else Periods(1) = 0 End If If (StartDate >= SP2) And (EndDate <= EP2) Then Periods(2) = DateDiff("m", StartDate, EndDate) ElseIf (StartDate < SP2) And (EndDate <= EP2) Then Periods(2) = DateDiff("m", SP2, EndDate) ElseIf (StartDate < SP2) And (EndDate > EP2) Then Periods(2) = DateDiff("m", SP2, EP2) ElseIf (StartDate >= SP2) And (EndDate > EP2) Then Periods(2) = DateDiff("m", StartDate, EP2) Else Periods(2) = 0 End If If (StartDate >= SP3) And (EndDate <= EP3) Then Periods(3) = DateDiff("m", StartDate, EndDate) ElseIf (StartDate >= SP3) And (EndDate > EP3) Then Periods(3) = DateDiff("m", StartDate, EP3) Else Periods(3) = 0 End If DatePeriod = Periods(Interval) End Function finish .mdb

وعليكِ السلام ورحمة الله وبركاته لنقم بتغيير طريقة السؤال على النحو التالي.. ماهو المبلغ الذي إذا أضفنا عليه الضريبة (%15) صار (1000)؟ وللإجابة على هذا السؤال؛ يجب أن نفهم أنه لا يمكن أن نضرب النسبة المجردة (0.15) في (1000) لسببين الأول أن هذه العملية تعيد (%15) بالنسبة إلى (1000) وليس إلى المبلغ المطلوب إضافة النسبة إليه ليصبح ألفا.. الثاني أن ناتج هذه العملية يعيد مبلغ النسبة إلى الأف، وحاصله (150). وهنا لا يمكن بتاتا القول أن المبلغ المطلوب هو (1000-150)! هذا فضيع.. إذا ماذا نعمل؟! وكيف نجيب على السؤال؟! في العمليات المحاسبية لا نستخدم النسبة المجردة (0.15) بل نستخدم (1.15)! إذا أردنا أن نعيد مبلغ 1000 مضافاً إليه ضرييبة %15 فستكون العملية الحسابية: 1000*1.15 إذا أردنا أن نعرف المبلغ الذي إذا أضفنا إليه %15 صار 1000 فستكون العملية الحسابية: 1.15/1000 أرجو أن تكون الفكرة وصلت!

وعليكم السلام ورحمة الله و بركاته يمكن وضع هذه القيمة في المحدد الأخير لتابع فتح التقرير Dim stDocName As String stDocName = "Q1" DoCmd.OpenReport stDocName, acViewPreview, , , , 16000 '** يمكن أخذ القيمة من مربع نص وفي التقرير في خدث عند الفتح أضف النص التالي في الأعلى Private Sub Report_Open(Cancel As Integer) Dim Allrecords As Integer If Not IsNull(Me.OpenArgs) Then Allrecords = Me.OpenArgs End If

التعديل 1384015853_.accdb