اذهب الي المحتوي
أوفيسنا

Foksh

الخبراء
  • Posts

    2991
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    117

كل منشورات العضو Foksh

  1. مشاركة مع أخي الكريم @ازهر عبد العزيز .. Private Sub dev_AfterUpdate() If Me.dev < 5000000000 Then Me.Undo End If End Sub
  2. تفضل يا صديقي ،، التعديل الجديد :- Private Sub ExportReport(formatType As String, userName As String) On Error Resume Next Dim fileName As String Select Case formatType Case "PDF" fileName = userName & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh nn AM/PM") & ".pdf" Case "RTF" fileName = userName & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh nn AM/PM") & ".doc" Case "Excel" fileName = userName & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh nn AM/PM") & ".xls" End Select Dim filePath As String With Application.FileDialog(2) .Title = "اختر موقع الحفظ" .AllowMultiSelect = False .InitialFileName = fileName If .Show = -1 Then filePath = .SelectedItems(1) Else Exit Sub End If End With Dim outputFormat As Variant Select Case formatType Case "PDF" outputFormat = acFormatPDF Case "RTF" outputFormat = acFormatRTF Case "Excel" outputFormat = acFormatXLS End Select DoCmd.OutputTo acOutputReport, namerpts, outputFormat, filePath, True, , , acExportQualityPrint End Sub الملف بعد التعديل :- ( شريط طباعة.accdb )
  3. قمت بتغيير النهج عن السابق ، ويبدو انني قد اغفلت عن تجربة زري الـ Pdf و الـ Rtf . 🤦 حالما اصل المنزل سأقوم بالتعديل إن شاء الله
  4. تفضل ، هذا تعديل سريع ، جربه وأخبرني بالنتيجة :- Private Sub ExportReport(formatType As String, userName As String) On Error Resume Next Dim fileName As String fileName = userName & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh nn AM/PM") & IIf(formatType = "PDF", ".pdf", IIf(formatType = "Excel", ".xls", ".doc")) Dim filePath As String With Application.FileDialog(2) .Title = "اختر موقع الحفظ" .AllowMultiSelect = False .InitialFileName = fileName If .Show = -1 Then filePath = .SelectedItems(1) Else Exit Sub End If End With Dim outputFormat As Integer Select Case formatType Case "PDF" outputFormat = acFormatPDF Case "RTF" outputFormat = acFormatRTF Case "Excel" outputFormat = acFormatXLSX Case Else Exit Sub End Select If outputFormat = acFormatXLSX Then DoCmd.OutputTo acOutputReport, namerpts, outputFormat, filePath, True, , , acExportQualityPrint Else DoCmd.OutputTo acOutputReport, namerpts, outputFormat, filePath, True, , , acExportQualityPrint End If End Sub وعليه فأن الإستدعاء لزر الحفظ Excel سيكون على الشكل التالي :- ExportReport "Excel", Me.Namea.Value الملف بعد الإضافة والتعديل ( شريط طباعة.accdb )
  5. إذا كان الغرض أو الهدف هو الحفاظ على دقة الحسابات وتقليل التعقيد ، فباعتقادي استخدام DateDiff مع Round هو حل جيد وأبسط ، بشرط أن تكون القيمة المستخدمة للتحويل منطقية في سياق تطبيقك . لاحظ أنه في الفرق سيكون معك على المدار الأبعد زيادة في الأيام بشكل بسيط يكاد يكون ملحوظ .
  6. استبدل الدالة السابقة بالتالي :- Private Sub ExportReport(formatType As String, userName As String) On Error Resume Next Dim fileName As String fileName = userName & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh nn AM/PM") & IIf(formatType = "PDF", ".pdf", ".doc") Dim filePath As String With Application.FileDialog(2) .Title = "اختر موقع الحفظ" .AllowMultiSelect = False .InitialFileName = fileName If .Show = -1 Then filePath = .SelectedItems(1) Else Exit Sub End If End With DoCmd.OutputTo acOutputReport, namerpts, IIf(formatType = "PDF", acFormatPDF, acFormatRTF), filePath, True, , , acExportQualityPrint End Sub أما فيما يتعلق بالتصدير كملف Excel فأعتقد أنه قد يختلف عما يدور في خيالك وله ضبط خاص .
  7. معلمي القدير وأستاذنا الجليل @ابوخليل :- في الدالة Now ، لن ينجح الأمر والسبب باعتقادي هو احتواء التنسيق على حروف غير مسموح بها كإسم لملف أو مجلد = " : " وهو النقطتين هذا رأيي ما لم يكن هناك سبب آخر ، حيث أنه في التنسيق المصاحب للدالة Now في الأكواد تم ضبط التنسيق بإزالة النقطتين . لم انتبه لرد الأستاذ @محمد احمد لطفى ، فلم يكن الرد موجوداً قبل ردي واعتقد أنني كنت في الصفحة مسبقاً ولم أعمل تحديث
  8. أعتقد أنه يمكنك ذلك ، من خلال الكود التالي ، قم بالتجربة والرجوع بالنتيجة ( لأنني لا استوعب فكرة أم تكون السنة 360 ، أو اعتبار أن جميع الشهور 30 يوم ) Function DateDiff360(date1 As Date, date2 As Date) As Long Dim monthsDiff As Long monthsDiff = DateDiff("m", date1, date2) Dim daysDiff As Long daysDiff = DateDiff("d", DateAdd("m", monthsDiff, date1), date2) DateDiff360 = monthsDiff * 30 + daysDiff End Function ويتم الإستدعاء كالتالي :- Dim daysDifference As Long daysDifference = DateDiff360([Date1], [Date2])
  9. ومشاركة مع الأستاذ محمد لطفي ، قمت بإنشاء دالة واحدة يتم استدعائها في اي من الزرين لتنفيذ المهمة حسب الزر . Private Sub أمر17_Click() ExportReport "PDF", Me.Namea.Value End Sub Private Sub أمر18_Click() ExportReport "RTF", Me.Namea.Value End Sub Private Sub ExportReport(formatType As String, userName As String) On Error Resume Next Dim fileName As String fileName = userName & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh nn AM/PM") & IIf(formatType = "PDF", ".pdf", ".doc") Dim filePath As String filePath = CurrentProject.Path & "\" & fileName DoCmd.OutputTo acOutputReport, namerpts, IIf(formatType = "PDF", acFormatPDF, acFormatRTF), filePath, True, , , acExportQualityPrint End Sub ملفك بعد التعديل ( شريط طباعة.accdb )
  10. أنصحك بفتح موضوع مستقل لطلبك حتى تلقى الإجابة المطلوبة
  11. وعليكم السلام ورحمة الله وبركاته ،، فقط استبدل مصدر سجلات النموذج الفرعي ، بالإستعلام التالي ( SQL ) :- SELECT s10.g10s1, s10.g1s1, s10.g1s29, s10.g1s30 FROM s10 WHERE (((s10.g1s1)=[Forms]![copy2]![g1s1]) AND ((s10.g1s30)=(SELECT MAX(g1s30) FROM s10 WHERE g1s1 = [Forms]![copy2]![g1s1] ))); حيث تم اضافة شرطين للإستعلام دون تغيير أو تعديل أي شيء في تصميمك ، ولكني أنصحك بالإبتعاد عن المسميات المحجوزة في آكسيس مثل Copy لإنه اسم إجراء في آكسيس ؛ وهذا سيلافيك حدوث أخطاء ومشاكل في المستقبل . ملفك بعد التعديل : ( copy.accdb )
  12. اعتذر اختي الكريمه على عدم الرد ، بسبب العمل من جهة ، ومن جهة أخرى عند قراءة الكود لاحظت تكرار الحلقة For A = 1 To 1 وأعتقد انك لست بحاجة لتكرارها وقد يكون هناك إمكانية لتنفيذ الحلقه التكرارية مرة واحدة على ما أعتقد. كل الاحترام والتقدير لشخصك الكريم 😇
  13. تصديقاً وتأكيداً لكلامك أستاذي الفاضل هو فعلاً في إحدة تجاربي عثرت على هذا الاسم prscs ، ولم يخطر في بالي أنه هو 🥺 فتجاهلته وافترضت انه الفاصل بين اسماء القوائم الرئيسية 🤦 ولكن فعلاً معلمنا قدها ، وجاب الذيب من ذيله 🙏
  14. ارفق ملف اخي الكريم
  15. - ما المقصود بالربط من قاعدة 1 الى آخر قاعدة 36 ؟؟؟؟؟؟ - ما علاقة Dlookup البحث عن سجل بالربط !!! - عند الاستعلام يلحق الى جدول الثالث يلتف من القاعدة الاولى الى اخر قاعدة !!!! حاولت الربط بين الأفكار ولم استدل على المعنى والمطلوب .
  16. إن كنت في البداية قد فهمت المطلوب ، فالآن للأسف لم افهم
  17. يعني على فرضاً ان لديك 10 قواعد بيانات ( واحدة منها الرئيسية ، والـ 9 الباقيات هن قواعد بيانات الجداول ) ، وتريدين استخدام الدالة DLookup للبحث عن سجل محدد داخل جدول محدد ، بحيث يقوم الكود ( الذي تريدينه ) بالبحث عن هذا السجل ولكن داخل جميع قواعد البيانات الخلفية ( الخاصة بالجداول ) !!!!!!!!!!!!!!!!!! أتمنى أن لا يكون هو المقصود
  18. ومشاركة مع معلمي الأفاضل ، دعني أضيف قطرة من بحر علمهم 😇 . يمكننا باستخدام دالة Mid والتي تستخدم لاستخراج جزء معين من النص ، وعلى افتراض أن اسم الحقل النصي هو MyDate ، يمكنك استخدام الاستعلام التالي لاستخراج السنة : SELECT MyDate, Mid(MyDate, InStrRev(MyDate, "/") + 1, 4) AS YearNum FROM YourTable; * طبعاً مع تغيير اسم الجدول أيضاً في YourTable ؛ و أيضاً لم أقم بمشاهدة ملف الأستاذ محمد لطفي أيضاً 🤗 إن كان قد استخدم اسلوب الاستعلام . واذا أردنا توسيق الفكرة كما أشار المعلم الفاضل الأستاذ جعفر ، قد نجعل الاستعلام بهذا الشكل ايضاً بحيث مع اختلاف اتجاه كتابة التاريخ ( من اليمين لليسار أو العكس ) أو ايضاً بدلاً من الفاصل "/" يمكن ان يكون "-" على سبيل المثال , SELECT MyDate, IIf(InStr(MyDate, "-") > 0, Left(MyDate, 4), IIf(Len(MyDate) = 10, IIf(Left(MyDate, 4) Like "####", Left(MyDate, 4), Right(MyDate, 4)), Null) ) AS YearNum FROM YourTable;
  19. حاولت الوصول إلى معنى واضح ، لكن ما قدرت 😅 اذا امكن اختنا الفاضله انك توضحي طلبك بشكل بسيط حتى لو 10000 جملة 😇 المهم انك توصلي فكرة السؤال والطلب ببساطة
  20. وعليكم السلام ورحمة الله وبركاته ,, اخي الكريم انت استخدمت الدالة DLookup لجلب رقم المقترض ( على ما أعتقد ) بناءً على اسم الموظف في الكومبوبوكس ، هل هذا صحيح ؟؟ وبإمكانك بدلاً من ذلك استخدام نفس مصدر الكومبوبوكس com1 ولكن هنا سنختار العمود رقم 2 حيث :- ( العمود 0 = اسم الموظف ، والعمود 1 = الجهة ، والعمود 2 = رقم المقترض ) ، لذا تم استبدال الجملة التالية :- Me.n2 = DLookup("[num]", "karz", "nam LIKE '*" & Me.com1 & "*'") بالجملة :- Me.n2 = com1.Column(2) أيضاً تم إجراء تعديل بسيط على عدد الأعمدة في الكومبوبوكس com1 وعرض كل عمود ؛ كما في الصورة :- الملف بعد التعديل القرضة الحسنة اصدار 31.zip
  21. ومشاركة مع أستاذي الجليل @jjafferr Me.YourTextBox = UCase(Me.YourTextBox)
  22. وعليكم السلام ورحمة الله وبركاته .. ارفق ملف أخي الكريم ( وهذا مهم جداً ) ، وكمحاولة جرب التعديل البسيط التالي :- Me.n2 = DLookup("[num]", "karz", "nam LIKE '*" & Me.com1 & "*'") سيبحث التعديل السابق عن أي جزء من النص ، وبالتالي قد يكون أكثر دقة إذا كانت هناك تباينات في الكتابة أو أخطاء بسيطة في البيانات .
  23. تم الاطلاع مسبقاً اخي الكرم .. Cal error.accdb
  24. أخي الكريم مؤيداً لما تفضل به معلمينا ، و وجهة نظر أخرى .. فإذا كانت القيمة المطلوبة هي نتيجة قسمة حقلين مختلفين استناداً إلى شروط معينة ، يمكننا تعديل كودك بحيث يستخدم دالة DLookup للحصول على القيمتين ثم يقسمهما مباشرةً ، ومن ثم يقوم بتقريب الناتج وحفظه في الحقل المطلوب. جرب الكود التالي :- Private Sub Command7_Click() Dim value1 As Variant Dim value2 As Variant Dim result As Variant value1 = DLookup("result", "Table1", "[code] = 33") value2 = DLookup("result", "Table1", "[code] = 36") If Not IsNull(value1) And Not IsNull(value2) And value2 <> 0 Then result = Round(value1 / value2, 3) Me.C = result Else MsgBox "قيم غير صحيحة" End If End Sub جرب وأخبرنا بالنتيجة ..
×
×
  • اضف...

Important Information