اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

  1. ابو جودي

    ابو جودي

    أوفيسنا


    • نقاط

      15

    • Posts

      7001


  2. hanan_ms

    hanan_ms

    03 عضو مميز


    • نقاط

      3

    • Posts

      313


  3. ابوخليل

    ابوخليل

    أوفيسنا


    • نقاط

      2

    • Posts

      12702


  4. الحلبي

    الحلبي

    04 عضو فضي


    • نقاط

      2

    • Posts

      822


Popular Content

Showing content with the highest reputation on 05/31/24 in all areas

  1. باش مهندسة @hanan_ms والدكتورة @safaa salem5 اتفضلو المرفق ده Full Control Of Print Report التحكم في الطابعة وخصائصها طباعة التقارير.mdb
    4 points
  2. وعليكم السلام ورحمة الله وبركاته يمكن إضافة شرط لعمود B عن طريق استخدام دالة IF مع دالة SEARCH للتحقق مما إذا كانت قيمة في عمود B تحتوي على الاسم الذي تريد البحث عنه. فيما يلي مثال على كيفية إضافة هذا الشرط: =IF(AND((SUMIF($A$1:A2;A2;$D$1:D2)-SUMIF($A$1:A2;A2;$C$1:C2))=0;D2=0; SEARCH("اسم الصنف";B2)>0);E2*C2;IF(AND(C2-D2>=0;G1=0);E2*(C2-D2)+F2;IF(SUMIF($A$1:A2;A2;$C$1:C2)-SUMIF($A$1:A2;A2;$D$1:D2)<=0;SUMIF($A$1:A2;A2;$F$1:F2)/SUMIF($A$1:A2;A2;$D$1:D2)*C2;((SUMIF($A$1:A2;A2;$F$1:F2)/SUMIF($A$1:A2;A2;$D$1:D2))*(SUMIF($A$1:A2;A2;$D$1:D2)-SUMIF($A$1:A2;A2;$G$1:G2)))+((SUMIF($A$1:A2;A2;$C$1:C2)-SUMIF($A$1:A2;A2;$D$1:D$2))*E2)))) يجب استبدال "اسم الصنف" بالاسم الذي تريد البحث عنه في عمود B. هذا الشرط سيحقق ما إذا كانت قيمة في عمود B تحتوي على الاسم الذي تم تحديده وفقط ينفذ الحساب إذا كان الشرط صحيحًا. ويمكن استخدام كود VBA الذي يضيف شرطًا للدالة في العمود H بناءً على القيم في عمود B: ``vba Sub AddConditionToColumnH() Dim lastRow As Integer Dim i As Integer lastRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lastRow If Cells(i, 2).Value Like "*اسم الصنف*" Then 'يتم استبدال "اسم الصنف" بالاسم الذي تريد البحث عنه If WorksheetFunction.And((Application.WorksheetFunction.SumIf(Range("A$1:A" & i), Cells(i, 1), Range("D$1:D" & i)) - Application.WorksheetFunction.SumIf(Range("A$1:A" & i), Cells(i, 1), Range("C$1:C" & i))) = 0, Cells(i, 4) = 0) Then Cells(i, 8).Value = Cells(i, 5) * Cells(i, 3) 'قم بإضافة بقية الشروط هنا تحت الشرط السابق End If End If Next i End Sub ``` يرجى استبدال "اسم الصنف" بالقيمة التي تبحث عنها في عمود B. هذا الكود سيقوم بتنفيذ الحسابات في العمود H للصفوف التي تحتوي على القيمة المحددة في عمود B. يمكنك إضافة بقية الشروط والحسابات وفقًا لاحتياجاتك.
    2 points
  3. السلام عليكم ورحمة الله تعالى وبركاته اخوانى الكرام اساتذتى الاعزاء الموضوع ده بصراحة كان تحدى بينى وبين نفسي تعبت جدا فكرة الموضوع التقليدية هى التعامل بالارقام واسماء العناصر وكتابة الكثير والكثير من الاكواد والزحمة والحسابات و و وبلا بلا بلا بلا... وفى النهاية يبقى التعديل على العمل بالاضافة او التعديل شئ صعب جدا جدا جدا الا انه بفضل الله اقدم اليكم الفكرة الاتية للتجربة اعتمدت فى المقام الاول على ان تكون الاكواد ثابته بحيث يسهل استخدام الفكرة والطريقة ونقلها لاى قاعدة ولكن عجزت عن تحقيق كل شئ برمجيا وتوقفت وعجزت امام نقطة واحدة ووحيدة ولكن تم التغلب بالفهلوة على المشكلة اترك لكم التجربة وباب النقاش مفتوح بعد ذلك ومن يدرى فد اجد حل للمشكلة التى عجزت امامها معكم وعندكم تعديل جديد بتاريخ 31/05/2024 تم تحديث الموضوع باضافة الاصدار الثانى الذى يعتمد كليا على الوحدات النمطية تم حل جميع المشاكل والعقبات برمجيا والتى واجهتنى بالاصدار الاول على الرغم من انه قد تم التغلب عليها وقتها ولكن بحلول غير برمجية الإصدار الأول : expand and collapse button .accdb الإصدار الثاني (المحسن) : expand and collapse button V2.zip
    1 point
  4. تحويل الوقت والتاريخ المحلى الي التوقيت عن التوقيت العالمي الموحد (UTC) عرض تاريخ و اوقات دول او مدن مختلفة في نفس الوقت بناء على فرق الوقت بينعم ولين التوقيت العالمي الموحد جدول tblTimeZones والذى يتكون من الحقول ShowInForm : اختيار البلدان للعرض في النموذج CountryName : اسماء المدن و البلدان TimeDifference : فرق التوقيت عن التوقيت العالمي الموحد (UTC) الفارق الزمني (بالساعات، مع إشارة "+" أو "-") DaylightSavingTime : التوقيت الصيفي اولا اكواد الوحدة النمطية Option Compare Database Option Explicit #If VBA7 Then Private Declare PtrSafe Function GetSystemTimeAPI Lib "kernel32" Alias "GetSystemTime" (lpSystemTime As SYSTEMTIME) As Long #Else Private Declare Function GetSystemTimeAPI Lib "kernel32" Alias "GetSystemTime" (lpSystemTime As SYSTEMTIME) As Long #End If Private Type SYSTEMTIME ' Structure for SYSTEMTIME wYear As Integer wMonth As Integer wDayOfWeek As Integer wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type Public Function GetUTC() As Date ' Function to get the current UTC time Dim utctime As Date Dim sysTime As SYSTEMTIME Call GetSystemTime(sysTime) utctime = DateSerial(sysTime.wYear, sysTime.wMonth, sysTime.wDay) + TimeSerial(sysTime.wHour, sysTime.wMinute, sysTime.wSecond) GetUTC = utctime End Function Private Function GetSystemTime(lpSystemTime As SYSTEMTIME) As Long ' Declaration to get system time GetSystemTime = GetSystemTimeAPI(lpSystemTime) End Function هذه الدوال توفر الحصول على الوقت الحالي بالتوقيت العالمي (UTC) SYSTEMTIME هو هيكل يستخدم لتخزين التاريخ والوقت GetSystemTimeAPI هى احد دوال API لـ Windows وظيفتها الحصول على الوقت العالمي (UTC) GetUTC هى دالة تستدعي الدالة GetSystemTimeAPI للحصول على الوقت الحالي بالتوقيت العالمي (UTC) ويتم اعادته كقيمة تاريخ/وقت طيب بعد ذلك الاكواد داخل النموذج النموذج يعرض توقيتات متعددة لدول مختلفة بناء على الاعدادات الموجودة في الجدول tblTimeZone Const FormatDisplayDate As String = "dd/mm/yyyy" Const FormatDisplayTime As String = "hh:mm:ss AM/PM" Const CountDisplayCountry As Integer = 5 Private Sub Form_Load() ' Set the form's timer interval to update every 1 second Me.TimerInterval = 1000 ' Call the function to update times and dates UpdateTimes End Sub Private Sub Form_Timer() ' Call the function to update times and dates when the timer event occurs UpdateTimes End Sub Private Sub UpdateTimes() On Error GoTo ErrorHandler Dim rs As DAO.Recordset Dim utctime As Date Dim i As Integer ' Get the current UTC time utctime = GetUTC() ' Debug.Print "UTC Time: "; utctime ' Open the recordset to fetch data from the tblTimeZones table Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblTimeZones WHERE ShowInForm = True") ' Check if recordset is not empty If Not rs.EOF Then rs.MoveFirst i = 1 ' Loop through each record in the recordset and update the form fields Do While Not rs.EOF And i <= CountDisplayCountry ' Limiting to 5 fields as per your requirement ' Assign values to form fields for each country If FieldExists("txtCountry" & i) Then Me("txtCountry" & i) = rs!CountryName Me("txtTimeDifference" & i) = rs!TimeDifference Me("chkDaylightSavingTime" & i) = rs!DaylightSavingTime ' Adjust time and date based on daylight saving time Dim localTime As Date If rs!DaylightSavingTime Then localTime = DateAdd("h", rs!TimeDifference + 1, utctime) Else localTime = DateAdd("h", rs!TimeDifference, utctime) End If Me("txtTime" & i) = Format(localTime, FormatDisplayTime) Me("txtDate" & i) = Format(localTime, FormatDisplayDate) End If rs.MoveNext i = i + 1 Loop Else ' Display a message if no records found for countries to display 'MsgBox "No countries found to display in the form.", vbExclamation, "No Records" Exit Sub End If ' Close the recordset rs.Close Set rs = Nothing Exit Sub ExitHandler: Exit Sub ErrorHandler: Select Case Err.Number Case 2465 ' Can't find the Object Resume ExitHandler Case Else MsgBox "Error in UpdateTimes: " & Err.Number & vbCrLf & Err.Description, vbExclamation 'Debug.Print Err.Number & " " & Err.Description Resume ExitHandler End Select End Sub Private Function FieldExists(fieldName As String) As Boolean ' Check if a field exists in the form On Error Resume Next FieldExists = (Me(fieldName).Name <> "") On Error GoTo 0 End Function الاعلان عن الثوابت Const FormatDisplayDate : للتحكم فى شكل تسيق التاريخ الذى سوف يتم عرضه Const FormatDisplayTime : للتحكم فى شكل تسيق الوقت الذى سوف يتم عرضه Const CountDisplayCountry : تحديد عدد الدول التى نريد عرض اوقاتها فى النموذج والذى على اساسة ايضا عدد العناصر فى النموذج لهذه البيانات Form_Load: عند تحميل النموذج، يتم تعيين الفاصل الزمني للمؤقت إلى ثانية واحدة ثم يتم استدعاء الدالة UpdateTimes Form_Timer: يتم استدعاء الدالة UpdateTimes كل ثانية لتحديث التوقيتات UpdateTimes وظيفة هذه الدالة هي الحصول على الوقت الحالي بالتوقيت العالمي (UTC) باستخدام الدالة GetUTC فتح مجموعة السجلات من الجدول tblTimeZones لجلب البيانات بناؤ على شرط أن يكون الحقل ShowInForm مضبوطًا على True في حلقة تكرارية يتم تحديث البيانات في العناصر في النموذج بناء على بيانات السجلات مع الأخذ بعين الاعتبار التوقيت الصيفي إذا كان مفعلاً يتم التعامل مع الأخطاء باستخدام كتلة ErrorHandler لضمان عدم تعطل البرنامج بسبب الأخطاء FieldExists: دالة للتحقق مما إذا كان عنصر معين موجودا في النموذج جدول tblTimeZones يحتوي على بيانات عن بلدان مختلفة بما في ذلك فرق التوقيت والتوقيت الصيفي وما إذا كانت البيانات يجب عرضها حيث يتم عرض البلدان المحددة فقط من خلال (ShowInForm = True) في النموذج العناصر فى النموذج كالاتى txtCountry1, txtCountry2, txtCountry3, txtCountry4, txtCountry5 المفروض يتم جلب اسماء البلدان من الجدول هنا ----------------------------------- txtTime1, txtTime2, txtTime3, txtTime4, txtTime5 المفروض يتم عرض التوقيت المحلى لكل بلد هنا ----------------------------------- txtTimeDifference1, txtTimeDifference2, txtTimeDifference3, txtTimeDifference4, txtTimeDifference5 المفروض يتم جلب الفرق في التوقيت لكل بلد هنا ----------------------------------- chkDaylightSavingTime1, chkDaylightSavingTime2, chkDaylightSavingTime3, chkDaylightSavingTime4, chkDaylightSavingTime5 المفروض يتم عرض ان كان التوقيت الصيفي مفعلا ام لا هنا ----------------------------------- txtDate1, txtDate2, txtDate3, txtDate4, txtDate5 المفروض يتم عرض التاريخ طبقا للتوقيت المحلى لكل بلد هنا ----------------------------------- المفروض كل ذلك يحدث من خلال الكود بمجرد فتح النموذج بطريقة الية والشرط طبعا هو جلب البيانات بناء على البلدان المختارة عرض بيناتها من خلال اختيارها من الحقل ShowInForm واخيرا المرفقات المرفق الاول وهو الاساس والذى تم استعراض الافكار والاكواد السابقة طبقا له المرفق الثانى فقط تم اضافة عدد نماذج لساعات على ان تكون نماذج فرعية TimeZones.zip TimeZones UP 2.zip
    1 point
  5. الله عليك يااستاذ محمد عصام ونعم الشرح والتوضيح وسوف يأخذ فى الاعتبار الملحوظة الثغنونةـ وبهذا الشرح المتقن لا يكون عندى اى عذر فى اطبق هذا الشرح على جميع اعمالى واسمح لى استاذ محمد (فكرتنى بايام المذاكرة) هذ الشرح يحتاج منى وقفة ودراسة لهذا الشرح وكما تعودت لا اترك كلمة والا قد فهمتها واذا توقف معى شئ سوف ارجع لك الان اصبح لدى ثلاث حلول حل الاستاذ @AlwaZeeR وحل شيخنا الجليل @ابوخليل وحل باشمهندسنا @ابو جودي جزاكم الله خيرا جميعا وزادكم الله علما نافعا واشكركم من كل قلبى واسمحوا لى اشكر الاستاذ/ محمد عصام ابو جودى على تعبه وهذا الشرح الذى سوف ياخذ منى وقت كبير بارك الله فيكم جميعا
    1 point
  6. ما شاء الله بجد يا باش مهندسة @hanan_ms روعة تسلم ايدك وأفكار قمة في الابداع
    1 point
  7. با نهار ابيض وجالك قلب تعدلى مرفقى بسهولة كده انتى بتهزرى يا باش مهندسة لا وبتقوليها فى وشى كمان تسلم ايدك بجد .. طبعا بهزر كل نرفقاتى ملك لاخوانى واخواتى الا شخص واحد الاستاذ @Moosak صاحب المكتبة العامرة جزاكم الله خيـــــــــرا وشرف لى يا باش مهندسة مشاركة حضرتك بجد والله
    1 point
  8. شكرا استاذنا Saleh Ahmed Rabie على تفاعلكم سلمت يداك
    1 point
  9. وعليكم السلام ورحمة الله وبركاته تفضل فصل الاسماء التي تحتوي على فاصل بينهم.xlsx
    1 point
  10. انا والله العظيم نفسى ربنا يجزيك كل خير ومش عارف اقولك ايه على حرصك الشديد بان يكون العمل كامل لا يابشمهندس انا منتظر الشرح
    1 point
  11. 🌹 @ابو جودي مشكور جدا استاذي CmToTwips فكرتك ممتازة بتحكم لكل هوامش التقارير بستخدام من غير تغير بإعداداة الصفحة لكل تقرير if Dlookup name Report ,Number=Number then ولكن هل يعمل على تغير التقرير بدل من الطول الى (العرض : عرض التقرير بوضع الاوفقي ) Public Function CmToTwips2(cm As Double) As Long CmToTwips2 = cm * ???'567 End Function جاري التجربة ❤️
    1 point
  12. ياريت هذا الموضوع فى الاكسس فقير جدا جدا جدا وكان الحل الافضل للتعامل مع الاسكانر من الاكسس برامج وسيطة من خلال Commanline خاص بها ولذلك الموضوع شبه معقد ونحن مجكومون فقط بما قد تقدمه لنا هذه البرامج الوسيطه بعكس مثلا التعامل مع الاسكانر من خلال ال vb.net يمكنك التحكم فى كل تفصيلة وكبيرة وصغيرة مباشرة من الاكواد
    1 point
  13. @ابو جودي استاذي سأحاول ارفاق مرفق لتحديد العرض والطول لاقتصاص كل صورة اسكنر مسحوبة
    1 point
  14. السلام عليكم مشكلتك الحقيقية في الاكواد والاجراء الذي يتم عند تحميل النموذج اليك حل بسيط ومحكم فقط التعامل يتم مع الحقول وليس مع النموذج اذا الحقول كثيرة جدا لديك .. يمكن التعامل معها بعمل لوب حفظ وتعديل4.rar
    1 point
  15. Option Compare Text Dim OneRng(), Rng, rCrit1, rCrit2 Public Property Get f() As Worksheet: Set f = Sheets("Stock") End Property Private Sub UserForm_Initialize() OneRng = f.Range("A4:I" & f.[A65000].End(xlUp).Row).value Rng = UBound(OneRng, 2) 'تنسيق التاريخ For i = LBound(OneRng) To UBound(OneRng): OneRng(i, 9) = Format(OneRng(i, 9), "dd/mm/yyyy"): Next i ' تنسيق عمود السعر For i = 1 To UBound(OneRng): OneRng(i, 3) = Format(OneRng(i, 3), "00.00"): Next i 'Code............ Me.ListBox2.ColumnCount = 9 Me.ListBox2.ColumnWidths = "40;55;60;60;60;0;0;0;50" End Sub عند اختيار مخزن معين فى ComboBox1 لايظهره فى هذا المخزن ComboBox2 وانما يظهر المخازن الاخرى Private Sub ComboBox1_AfterUpdate() If Me.ComboBox1 = "*" Then Me.ComboBox2 = "*" Set j = CreateObject("Scripting.Dictionary") j("*") = "" a = f.Range("E4:E" & f.[E65000].End(xlUp).Row) For i = LBound(a) To UBound(a) If (a(i, 1) <> "") And (Format(a(i, 1), "@") <> Me.ComboBox1.value) Then j(a(i, 1)) = "" Next i Me.ComboBox2.List = j.keys Set j = Nothing End Sub sell-the-first-quantity- V5.xlsm
    1 point
  16. عاوز نسخة مفتوحة لحسن هأعيط واخلى الناس تتلم عليك
    1 point
  17. يا باش مهندسة لا توجد اكواد لعمل ذلك اللهم الا اذا كان السيناريو من البداية يستخدم تطبيق الاسكانر كوسيط ولو ان التطبيق يدعم ال Commanline فى هذه الحالة ممكن هذا والله اعلى واعلم طبعا عن الاكس اتحدث وليس عن لغات برمجة اخرى
    1 point
  18. بصى يا باش مهندسة حنان خلينا نتفق على شئ الاكسس لا يتعامل بمقياس السنتيمتر فى القياسات ولكن يتعامل بالـ Twips يعنى الرقم اللى حضرتك ناوية تسجليه فى الجدول هيكون بالسنتميتر وطبعا ده كان وفقا لطلب الدكتورة سلمى اللى لازم تطلع عنينا بطلباتها لانها عاوزة تسجل الهوامش بالسنتميتر طيبا علشان نحول من انا كتبت الدالة دى Public Function CmToTwips(cm As Double) As Long CmToTwips = cm * 567 End Function فطبيعيى ان حضرتك لو كتبتى ارقام غير منطقية تحصلى على نتيجة غير منطقية لذلك انا افضل فكرة حضرتك DoCmd.RunCommand acCmdPageSetup
    1 point
  19. اتفضلى يا استاذة @safaa salem5 المرفق هوامش التقارير.accdb
    1 point
  20. انا جديده بالمنتدى وجدة لكي يا صفاء مثال بسيط من احدى المنتديات لتحكم بهوامش الصفحات وعدد طباعة التقرير من غير استخدام دوال اتوقع تشغيل التقارير بحدث التقرير Dim DefaultTop As Long Dim DefaultBottom As Long Dim DefaultLeft As Long Dim DefaultRight As Long ؟! Chack data tablet (1) Function into Report At Top And At Bottom At Mid >> .. How only Building Function Control report ?! sorry for Help U Function Error No Error Now Only Cod On_Click_Button '==================================(OPen_Control Report = ( acHidden)) تحكم بأعدادة طباعة وهوامش التقرير.rar
    1 point
  21. تنفيذ ماكرو بناء على قيمة خليه2.xlsb تفضل - الملف الأن يرحل تلقائى بدون الحاجة إلى زر للعمل طوال فترة العمل عليه تنفيذ ماكرو بناء على قيمة خليه2.xlsb
    1 point
  22. اولا اعتذر لم انتبه الى رد واجابة والدى الحبيب واستاذى الجليل ومعلمى القدير الاستاذ @ابوخليل يبدو اننى كنت منهمكا فى وضع الاجابة وبعد مشاهدة اجابة والدى الحبيب يبدو انه اعتمد فى الاجابة على تحويل قيم من سنتيمتر إلى twips ولذلك اثراء للموضع الطريقة الثانية اولا ننشئ جدول باسم tblMarginsSettings يحتوى على الجقول الاتية TopMargin (نوع البيانات: Number) BottomMargin (نوع البيانات: Number) LeftMargin (نوع البيانات: Number) RightMargin (نوع البيانات: Number) إنشاء نموذج لإدخال إعدادات الهوامش عناصر التحكم اللازمة لإدخال الهوامش (مربعات نصية) txtTopMargin txtBottomMargin txtLeftMargin txtRightMargin (زر أمر) btnSaveMargins الكود Private Sub btnSaveMargins_Click() ' Ensure only one record in tblMarginsSettings If DCount("*", "tblMarginsSettings") = 0 Then ' If no record, insert a new one DoCmd.RunSQL "INSERT INTO tblMarginsSettings (TopMargin, BottomMargin, LeftMargin, RightMargin) VALUES (" & Me.txtTopMargin & ", " & Me.txtBottomMargin & ", " & Me.txtLeftMargin & ", " & Me.txtRightMargin & ")" Else ' If record exists, update it DoCmd.RunSQL "UPDATE tblMarginsSettings SET TopMargin = " & Me.txtTopMargin & ", BottomMargin = " & Me.txtBottomMargin & ", LeftMargin = " & Me.txtLeftMargin & ", RightMargin = " & Me.txtRightMargin End If MsgBox "Margins settings saved successfully!" End Sub إنشاء الوحدة النمطية لإضافة الدالة العامة الكود Public Function CmToTwips(cm As Double) As Long CmToTwips = cm * 567 End Function وذلك لتحويل القيم من سنتيمتر إلى twips Public Sub SetReportMargins(rpt As Report, _ Optional ByVal DefaultTopCm As Double = 2.54, _ Optional ByVal DefaultBottomCm As Double = 2.54, _ Optional ByVal DefaultLeftCm As Double = 2.54, _ Optional ByVal DefaultRightCm As Double = 2.54) ' Convert default values from cm to twips Dim DefaultTop As Long Dim DefaultBottom As Long Dim DefaultLeft As Long Dim DefaultRight As Long DefaultTop = CmToTwips(DefaultTopCm) DefaultBottom = CmToTwips(DefaultBottomCm) DefaultLeft = CmToTwips(DefaultLeftCm) DefaultRight = CmToTwips(DefaultRightCm) Dim rs As DAO.Recordset On Error GoTo ErrorHandler Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblMarginsSettings") If Not rs.EOF Then rpt.Printer.TopMargin = CmToTwips(Nz(rs!TopMargin, DefaultTopCm)) rpt.Printer.BottomMargin = CmToTwips(Nz(rs!BottomMargin, DefaultBottomCm)) rpt.Printer.LeftMargin = CmToTwips(Nz(rs!LeftMargin, DefaultLeftCm)) rpt.Printer.RightMargin = CmToTwips(Nz(rs!RightMargin, DefaultRightCm)) Else rpt.Printer.TopMargin = DefaultTop rpt.Printer.BottomMargin = DefaultBottom rpt.Printer.LeftMargin = DefaultLeft rpt.Printer.RightMargin = DefaultRight End If rs.Close Set rs = Nothing Exit Sub ErrorHandler: MsgBox "Error setting margins: " & Err.Description If Not rs Is Nothing Then rs.Close Set rs = Nothing End If End Sub على ان يتم الاستدعاء فى التقرير عند فتح التقرير بالشكل التالى Private Sub Report_Open(Cancel As Integer) SetReportMargins Me End Sub
    1 point
  23. اولا ننشئ جدول باسم tblMarginsSettings يحتوى على الجقول الاتية TopMargin (نوع البيانات: Number) BottomMargin (نوع البيانات: Number) LeftMargin (نوع البيانات: Number) RightMargin (نوع البيانات: Number) إنشاء نموذج لإدخال إعدادات الهوامش عناصر التحكم اللازمة لإدخال الهوامش (مربعات نصية) txtTopMargin txtBottomMargin txtLeftMargin txtRightMargin (زر أمر) btnSaveMargins الكود Private Sub btnSaveMargins_Click() ' Ensure only one record in tblMarginsSettings If DCount("*", "tblMarginsSettings") = 0 Then ' If no record, insert a new one DoCmd.RunSQL "INSERT INTO tblMarginsSettings (TopMargin, BottomMargin, LeftMargin, RightMargin) VALUES (" & Me.txtTopMargin & ", " & Me.txtBottomMargin & ", " & Me.txtLeftMargin & ", " & Me.txtRightMargin & ")" Else ' If record exists, update it DoCmd.RunSQL "UPDATE tblMarginsSettings SET TopMargin = " & Me.txtTopMargin & ", BottomMargin = " & Me.txtBottomMargin & ", LeftMargin = " & Me.txtLeftMargin & ", RightMargin = " & Me.txtRightMargin End If MsgBox "Margins settings saved successfully!" End Sub إنشاء الوحدة النمطية لإضافة الدالة العامة الكود Public Sub SetReportMargins(rpt As Report, _ Optional ByVal DefaultTop As Long = 1440, _ Optional ByVal DefaultBottom As Long = 1440, _ Optional ByVal DefaultLeft As Long = 1440, _ Optional ByVal DefaultRight As Long = 1440) ' Default values are set to 1 inch (1440 twips) which is standard for A4 paper Dim rs As DAO.Recordset On Error GoTo ErrorHandler Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblMarginsSettings") If Not rs.EOF Then rpt.Printer.TopMargin = Nz(rs!TopMargin, DefaultTop) rpt.Printer.BottomMargin = Nz(rs!BottomMargin, DefaultBottom) rpt.Printer.LeftMargin = Nz(rs!LeftMargin, DefaultLeft) rpt.Printer.RightMargin = Nz(rs!RightMargin, DefaultRight) Else rpt.Printer.TopMargin = DefaultTop rpt.Printer.BottomMargin = DefaultBottom rpt.Printer.LeftMargin = DefaultLeft rpt.Printer.RightMargin = DefaultRight End If rs.Close Set rs = Nothing Exit Sub ErrorHandler: MsgBox "Error setting margins: " & Err.Description If Not rs Is Nothing Then rs.Close Set rs = Nothing End If End Sub على ان يتم استدعاءه فى التقرير عندف تح التقرير بالشكل التالى Private Sub Report_Open(Cancel As Integer) SetReportMargins Me End Sub وبذلك يكون هناك مرونة مع المعلمات الافتراضية للدالة SetReportMargins تتيح تحديد هوامش افتراضية في حال عدم وجود قيم في الجدول تم استخدام معايير A4 حيث ان القيم الافتراضية للهوامش تعادل 1 بوصة (1440 twips) لكل جانب وهي مناسبة لمقاسات ورق A4 يمكن استدعاء الدالة من أي تقرير بسهولة باستخدام هذا الكود، ستكون إعدادات الهوامش مرنة وقابلة للتعديل بسهولة، مع التأكد من وجود قيم افتراضية مناسبة عند الحاجة.
    1 point
  24. Private Sub Report_Open(Cancel As Integer) Dim T, L, B T = Nz(DLookup("top", "settings_Report_tbl"), 1) L = Nz(DLookup("left", "settings_Report_tbl"), 1) B = Nz(DLookup("bottom", "settings_Report_tbl"), 1) Me.Printer.TopMargin = T * 567 Me.Printer.LeftMargin = L * 567 Me.Printer.BottomMargin = B * 567 End Sub هامش تقرير2.rar
    1 point
  25. سامحني استاذ @بكيل الشوكي حاولت لكن اللغة العربية بالاسماء ( الجداول- الاستعلامات-النماذج -.............. ) ترهق نظري جداً . ويمكن يكون أحد اسباب تأخر الأخوة أيضاً (لخبطة البرمجة بسبب اللغة العربية) .
    1 point
  26. استكمالاً لما سبق في المشروع 👆 :- قد واصلنا العمل بإجراء بعض التعديلات على التصميم ، والأكواد ، وتم إضافة أفكار جديدة ، وأدعوكم لتجربة النسخة الأولى من البرنامج لنظام الـ 64 بت في الوقت الحالي . تم إضافة الوضع المصغر فوق شريط المهام في الويندوز . ويتحتوي على 3 أزرار ! الزر الذي سيكون له لونين ( الأخضر و الأحمر ) للخيارات والإعدادات . وطبعاً اللونين دلالة على وضعية شريط عرض الوقت للصلاة . ويتم تغيير الوظيفة من الزر التالي . الزر ذو اللونين ( الأخضر أو الأحمر ) لتفعيل وضع الشريط المصغر فوق التطبيقات أو خلفها . زر الإغلاق . تم إضافة نافذة تنبيه عند وقت الصلاة مع تنبيه صوتي يتم اختياره من Settings الإعدادات . إمكانية تفعيل الوضع المصغر حسب الحاجة أو الوضع الشامل من لوحة Settings الإعدادات أيضاً . Salawat.zip
    1 point
×
×
  • اضف...

Important Information