Foksh

شكراً لك ، ولكني لا أثق بالذكاء الإصطناعي ومقترحاته 😇 .

منذ ساعه, kkhalifa1960 said:

لابد ن توافر الشرط لضمان القيمة الصح   . الشرط  ......  تاريخ المعاملة مثلاً .

ليس بالضرورة إن كان الهدف الحصول على قيمة حقل محدد في آخر سجل ( شرط وجود حقل ترقيم مثلاً ) . ولكن إن كان ضمن شرط فعبارتك صحيحة 100% 

وهنا ممكن يستخدم حقل الترقيم كأساس على آخر قيمة .

وممكن استعمال دالة بسيطة مثل :-

Function GetLastValue(strField As String, strTable As String) As Variant
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset(strTable, dbOpenTable)
    rs.MoveLast
    GetLastValue = rs.Fields(strField).Value
    rs.Close
End Function

ويتم استدعائها في مربع نص غير منضم بتمرير اسم الجدول والحقل ، مثلاً :-

=GetLastValue("رقم الوارد";"وارد")

⏳  باقي من الوقت : 6 أيام حتى نهاية التحدى الثاني

وما زال البحث جاري عن مبتكرين وخلّاقي أفكار جديدة ، وليس أفكار نسخ ولصق ، وتعديل على أفكار موجودة

وعليكم السلام ورحمة الله وبركاته ..

أهلاً بك معنا أخي الكريم sgreffier_sf0315 ، ونسعد بانضمامك لأسرتنا الكبيرة هذه .

متأملين منك أن تقرأ شروط المشاركات في المنتدى هنا . ومنها كأساسيات وللتذكير :-

اقتباس

1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة
2-يجب استخدام خاصية البحث قبل طرح السؤال توفيرا للوقت و الجهد.
3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال.
4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا.....
5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم.
ومخالفة ذلك تعرض الموضوع للحذف

وأود لفت انتباهك إلى أن الزر "اختر تمت الإجابة" يستخدم عادة عندما تجد الحل لطلبك ، واختياره للمشاركة التي حققت لك طلبك .

أهلاً بك معنا 

الان, منتصر الانسي said:

غيرت الإسم فقط 😅

هههههههه انا قلت يمكن بعدل شي أو يضيف شي داخل الملف للتمييز بينهم 😛

1 دقيقه مضت, منتصر الانسي said:

ولكن في المجمل فإن إسترجاع النماذج والتقارير شيئ ليس بالقليل وياريت تشاركنا بالطريقة

إن شاء الله حال وصولي لنسبة ترضي غرور أفكاري 😁 ، لن أبخل عليكم بها 

15 دقائق مضت, منتصر الانسي said:

بصراحة أعتبر هذه النتيجة بحد ذاتها إنجاز 

بعض ما عندكم يا أستاذنا  الكبير ..

15 دقائق مضت, منتصر الانسي said:

المثال السابق كنت قد وضعت كلمة سر للتعليمات البرمجية ولكن كيف ستكون النتيجة إذا ماجعلناها بدون تأمين؟

هذا نفس الملف ولكن بدون تأمين للتعليمات البرمجية

أتمنى أن تكون قد غيرت به شيئاً مخفياً كي نميز بين المرفق السابق ، والتالي ..

Mont_ProgressBar_NoPassword.zip

8 دقائق مضت, منتصر الانسي said:

على فكرة إصدارات الأوفيس كانت تتغير كل سنة فمثلا 2003 كان الإصدار Office 11 وفي 2007 أصبح Office 12 وهكذا وحتى 2013 ولكن إبتداء من 2016 كله أصبح Office 16

بلا شك 👍

طبعاً المكتبات لا تعنيني نهائياً في فكرتي .. فأنا أقوم حالياً بجلب المكونات الى ملف ACCDB إصدارات حديثة = 2019 = نسخة الأوفيس التي لدي حالياً ..

1 ساعه مضت, Foksh said:

( دون أكواد VBA )

وبخصوص هذه النقطة ، جاري بناء مكتبة وخوارزمية كاملة ( مبنية على ملف VBA7.Dll ) تم كسر حمايته من إصدار أوفيس 2019 

18 ساعات مضت, منتصر الانسي said:

قمت بتحويل إحدى الأدوات التي رفعتها للمكتبة شوف إذا بتقدر تفكها

أستاذ @منتصر الانسي ، هذه تجربتي على استخراج النماذج بتصاميمها حرفياً ( دون أكواد VBA ) حالياً في المرحلة الأولى ..

Montaser.accdb

مطلوب قاعدة بيانات آكسيس 2003 مقفلة MDE . ولا يهمني الداتا التي فيها أبداً ولا حتى ان تكون لمشروع كامل

إذا سمحتم 🤗

46 دقائق مضت, منتصر الانسي said:

انا حسبت الموضوع واحد من التحديات الخاصة بك 😅

😈

للعلم أستاذ @منتصر الانسي ، انا ما زلت أبني أداتي ، وقد توصلت حالياً للإصدارات 2016 - 2019 تقريباً .. وانت قد قفزت بي لآخر لإصدار ههههههههه

ومن باب السؤال أستاذ @منتصر الانسي ، ما إصدار الأوفيس الذي استخدمته ؟؟

من باب الإحاطة بمعلومة 😊

15 دقائق مضت, منتصر الانسي said:

قمت بتحويل إحدى الأدوات التي رفعتها للمكتبة شوف إذا بتقدر تفكها

😅 اسم الملف يخوف هههههه

من قال اني داخل تحدي ، أعوذ بالله من غضب الله....

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

أخواني وأساتذتي ومعلمينا ( دون استثناء )

للضرورة القصوى لمن يرغب بالمساعدة ، مطلوب :-

1. قواعد بيانات مقفلة ومحمية تكون حصراً بصيغة ACCDE - لا حاجة لي بأي معلومات أو بيانات داخل الجداول ..
2. قواعد بيانات تالفة ( لا تفتح أساساً ) .

  الهدف هو تجربة لأداة جديدة قيد التجربة بعد أن تمت برمجتها من خلال آكسيس فقط  .

حيث وقعت في مشكلة كنت قد طرحتها في هذا الموضوع هنا . ما اضطرني لتطبيق نصيحة الحاجة أم الأختراع ، بعد البحث والتمعن لمدة 3 أيام متواصلة ..

5 ساعات مضت, أحمد العيسى said:

وتم التعديل بسهولة لدمج 3 كائنات فى زر أمر واحد ( زر استيراد الجدول )

تمت التجربة على اوفيس 2010 ، وما شاء الله عليك ، أجدت الدمج والتوظيف ..

ومن الجميل أن يكرّم الإنسان نفسه دائماً عند اجتهاده ، فلا تنسى اختيار "تمت الإجابة" لرسالتك التي تسبق رسالتي هذه . فأنت تستحقها بجدارتك 

7 دقائق مضت, AbuuAhmed said:

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

أستاذنا الغالي أبو احمد ،،

بداية أحترم رأيك بشدة ، وأنت من الأشخاص الذين لهم بصمة فعلية في تقديم المساعدة لأخوتنا في القسم متى حللتم ، رغم أننا نفتقد وجودكم بيننا والإستفادة من فيض العلم الذي علمكم الله أياه  .

أخونا جو طرح سؤاله النابع من مشكلة واجهها في كود جاهز حصل عليه من أداة ، لكنه لم يلبي حاجته بسبب عدم توافق الكود حرفياً وفعلياً مع طلبه عند التعامل مع رسالة MsgBox من 3 أزرار ,, وقدم له الأخوة مجموعة حلول البرمجية المنطقية ؛ إلا أنه تمسك بالحبل الذي بين يديه ولم يفضل تبديله .

لذا ومن ضمن الحلول كنت قد اقترحت عليه استخدام Select Case كما تفضلتم في طرحكم - إضافة إلى ما جاد به خبرائنا الكرام - مشكورين - ، فعاد إلى أصل الموضوع الذي حصل على الكود منه للأستاذ منتصر الأنسي - مشكوراً لجهده على انتاج الأداة - ، وقد لباه بتحديث يدعم Select Case حسب رغبته ..

لكم الشكر على ما تقومون به من مساعدة ومد يد العون لأخوانكم أينما حلّت أناملكم الذهبية  ..

وفي النهاية انت تعلم أن من يبحث عن إجابة رغم تعدد الحلول إلا أنه سيفضل الأسهل والأبسط لمشروعه وحاجته وخبرته  .

3 ساعات مضت, Foksh said:

الثاني حال وصولي الى الكمبيوتر إن شاء الله ، لأنني خرجت من العمل 

تفضل أخي الكريم ، التعديل الي طلبته ..

Private Sub btnLocateFile_Click()
    On Error GoTo Err_btnLocateFile_Click

    Dim fd As Object
    Dim fileName As String
    Dim defaultFolder As String

    defaultFolder = "D:\Access_Teacher\"

    If Dir(defaultFolder, vbDirectory) = "" Then
        MkDir defaultFolder
    End If

    Set fd = Application.FileDialog(1)

    With fd
        .Title = "اختر ملف الإكسل"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx"
        .InitialFileName = defaultFolder

        If .Show = -1 Then
            If .SelectedItems.Count > 0 Then
                fileName = .SelectedItems(1)
                Me.txtImportFile = fileName
            End If
        End If
    End With

Exit_btnLocateFile_Click:
    Exit Sub

Err_btnLocateFile_Click:
    MsgBox Err.Description, vbCritical + vbMsgBoxRight, "خطأ"
    Resume Exit_btnLocateFile_Click
End Sub

55 دقائق مضت, أحمد العيسى said:

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

والفتح إفتراضياً فى المجلد السابق

تمام ، تم الانتهاء من الشق الأول 👍

الثاني حال وصولي الى الكمبيوتر إن شاء الله ، لأنني خرجت من العمل 

منذ ساعه, أحمد العيسى said:

للتسهيل : ليكن فولدر الحفظ الإفتراضى (مع إمكانية الاختيار ) هو  D:\Access_Teacher

ليس لدي أوفيس 2003 ، ولكن جرب هذا التعديل لزر التصدير ..

Private Sub cm_ToExcel_Click()
    On Error GoTo Err_cm_ToExcel_Click

    Dim stDocName As String
    Dim filePath As String
    Dim defaultFolder As String
    Dim Q As Integer
    Dim fd As Object

    stDocName = "tbl_Teacher" & [Year_name]
    defaultFolder = "D:\Access_Teacher\"
    
    Q = DCount("*", "tbl_Teacher")

    If Q > 0 Then

        If Dir(defaultFolder, vbDirectory) = "" Then
            MkDir defaultFolder
        End If

        Set fd = Application.FileDialog(2)

        With fd
            .Title = "اختر مكان حفظ ملف الإكسل"
            .InitialFileName = defaultFolder & stDocName & ".xls"

            If .Show = -1 Then
                filePath = .SelectedItems(1)

                If LCase(Right(filePath, 4)) <> ".xls" Then
                    filePath = filePath & ".xls"
                End If

                DoCmd.TransferSpreadsheet acExport, 8, "tbl_Teacher", filePath, False

                MsgBox "تم استخراج ملف الإكسل بنجاح وحفظه في:" & vbCrLf & vbCrLf & _
                       filePath, vbInformation + vbMsgBoxRight, ""
            End If
        End With

    Else
        MsgBox "لا يوجد سجلات لتصديرها", vbOKOnly + vbMsgBoxRight, ""
    End If

Exit_cm_ToExcel_Click:
    Exit Sub

Err_cm_ToExcel_Click:
    MsgBox Err.Description, vbCritical + vbMsgBoxRight, "خطأ"
    Resume Exit_cm_ToExcel_Click
End Sub

قمت بتعديل الزر بحيث يعتمد اسم المسار الذي حددته لنا ، وإنشاء المجلد نفسه في المسار إذا لم يكن موجوداً ..

5 ساعات مضت, jo_2010 said:

استاذى الفاضل 

قمت بتغيير Undo الى  Exit Sub

واعطى نفس النتيجة السابقة وهو تنفيذ اخر  امر   فتح التقرير

اليك القاعدة للتعديل

JO.accdb 480 kB · 5 downloads

بعد تجربة المرفق ، والتمعن فيه ، مشكلتك أخي الكريم في الجزء :-

ElseIf vbNo Then

السبب طبعاً أنه لا يفحص نتيجة رد الرسالة الكلي ، بل يعتبر vbNo قيمة ثابتة . وبالتالي يدخل إليه دائماً إذا لم تكن النتيجة vbYes .

لذا فالأفضل من وجهة نظري ، والأصح هو استخدام Select Case في حالتك هذه . خلاف ذلك قد نضطر لاستخدام الرسالة مرتين في الجملة الشرطية ، وهذا سيكرر الرسالة مرتين داخل نفس الحدث . لذا جرب الفكرة التالية :-

Private Sub أمر0_Click()
Select Case MsgBox("ماذا تريد ان تفعل Yes فتح نموذج NO فتح تقرير Cancel تراجع" & vbCrLf & vbCrLf & "الحمدلله", _
                   vbYesNoCancel + vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, _
                   "الله المستعان")
    Case vbYes
        DoCmd.OpenForm "22"
    Case vbNo
        DoCmd.OpenReport "33", acViewPreview
    Case vbCancel
        Exit Sub
End Select
End Sub

6 ساعات مضت, amenbkr said:

السلام عليكم وكل عام واانتم بالف خير

وعليكم السلام ورحمة الله وبركاته ..

إليك أخي الفاضل مواضيع قد تم طرحها مسبقاً في المنتدى ، ممكن على سبيل المثال احدثها ..

10 ساعات مضت, jo_2010 said:

اريد التعديل علي الكود كما هو هل هذا ممكن

بدل كلمة Undo ، اجعلها Exit Sub فقط .

2 ساعات مضت, ابو البشر said:

هذه هي المكتبة المطلوبة

دعماً لما تفضل به أستاذنا ابو البشر ، المكتبة الموضحة في الصورة التالية :-

طبعاً الرقم 16.0 سيختلف حسب إصدار الأوفيس لديك . فللإصدارات التي أقل من 2016 سيكون الرقم 14.0

7 ساعات مضت, kkhalifa1960 said:

اليكم الشرح والمرفق .

                                                      

DD13901390-1.rar 639.1 kB · 4 downloads

مبدع كعاااادتك اخي خليفة ، تنفيذ جميل كما هو واضح من الشرح ،، 👏🏻

معلومة مهمة ، وطرف الخيط هذا ثمين جداً 🤗

بارك الله فيك اخي جعفر 💐

الان, منتصر الانسي said:

بس تعمل حسابك إن الرابط هيضل ثابت ماراح يتغير لو حصل أي تغيير في موقع الهدف

كلام صحيح 100%

الحمد لله ..