نموذج فرعي داخل صفحة رئيسية بقائمة جانبية

hanan_ms · يناير 4

مكتبة كافة الادوات المساعدة والمميزة والكواد والمشاريع 2026-2027 Ms_hanan : https://sites.google.com/view/mas-projectss/home

لضم بعض الاعمال وتنزيل المباشر الكل مفتوح المصدر :wink2:

********************************************************************************************************

توسيــــع واستكمال :biggrin2:

1- تعديل حركة اصبح بسلاسة في الجانبين لتسجيل الدخول من غير تداخل في الواجة الرئيسية
2- تغير الرسائل بتأشر رسالة بديلة في الواجهة الرئيسية
3- تغير حجم الرسالة مع تعديل التصميم للمعاينة
4- عند تغير الخلفية او الرمز اضافة زر التحديث
5- اضافة كل حساب صورة رمز خاصة فيه

6- تصحيح تحديث المزامنة يوجد شرح في الاعدادة

7- تصحيح عند العرض الكامل لا يمكن تحريك النافذة مع اضافة البار للتحريك وايضا في تغير كلمة المرور للمستخدم

...

المرفق اسفل الفيديو Google Drive

تحميل المرفق Google Drive

https://drive.google.com/file/d/1wkzvmsK8NxSNwyySyvqycke8ulc-1U9H/view?usp=drive_link

hanan_ms · يناير 10

مكتبة كافة الادوات المساعدة والمميزة والكواد والمشاريع 2026-2027 Ms_hanan : https://sites.google.com/view/mas-projectss/home

لضم بعض الاعمال وتنزيل المباشر الكل مفتوح المصدر :wink2:

********************************************************************************************************

توسيــــع واستكمال :biggrin2:

1- اضافة ادخال البيانات ( للمبالغ المالية بتحديد العملات - ادخال الوقت العالمي لكافة الدول ما عدا المولايات يجب ذكر الدول مع الفارق الوقت - ادخال الرقم المدني لكافة الدول - ادخال ارقام دول العالم )

- يوجد اختصارات التحكم مثال Space لتنقل لتحديد معيار الدول او المبالغ - back للاغلاق النموذج - Enert لاعتماد القيمة المحددة )

2- اضافة ادراج البيانات داخل القائمة مع الرجوع وعرض البيانات

- مع ترحيب عند الدخول وتصحيح التكبير 🙂

3- تعديل بسيط للقائمة لسهول التعامل مع تفريع القائمة باول الاسطر

Private Sub LoadSubForm(n As Integer)
'===========================( ضغط الزر
  '===================(n يعبر عن ارقام الازرار الفرعية بترتيب
  '===================( مثال IB1 افصل الرقم عن الاسم فأذن الرقم 1
    If n = 1 Then
    Form_Time_Sub_Not_Form.Lbl_Time.Visible = True
    Form_ss_2.MainSub.Visible = True
    Form_ss_2.MainSub.SourceObject = "MF_0"
    End If
    
     If n = 2 Then Form_ss_2.MainSub.Visible = False
     If n = 3 Then Form_ss_2.MainSub.Visible = False
     If n = 4 Then Form_ss_2.MainSub.Visible = False
     If n = 5 Then Form_ss_2.MainSub.Visible = False
     If n = 6 Then Form_ss_2.MainSub.Visible = False
     If n = 7 Then Form_ss_2.MainSub.Visible = False
     If n = 8 Then Form_ss_2.MainSub.Visible = False
     If n = 9 Then Form_ss_2.MainSub.Visible = False
     If n = 10 Then Form_ss_2.MainSub.Visible = False
     If n = 11 Then Form_ss_2.MainSub.Visible = False
     If n = 12 Then Form_ss_2.MainSub.Visible = False

End Sub

4- اضافة اربع انواع للقواعد للاضافة التلقائية والتجديد

....

تابع الفيديو للتوضيح

تحميل المرفق https://drive.google.com/file/d/1iXXhL4xLaC7vx84VQEro2ZohuifRNt8p/view?usp=drive_link

hanan_ms · يناير 17

مكتبة كافة الادوات المساعدة والمميزة والكواد والمشاريع 2026-2027 Ms_hanan : https://sites.google.com/view/mas-projectss/home

لضم بعض الاعمال وتنزيل المباشر الكل مفتوح المصدر :wink2:

********************************************************************************************************

توسيــــع واستكمال :biggrin2:

1- اضافة اقلاع ولكن للعرض تغير الكود + مفاتيح الترخيص + تصحيح المسارات عند نقل الى جهاز جديد

2- تصحيح ووضع جميع تجربة صندوق رسائل الادخال في نافذة

3- اضافة اعدادة التحكم بصناديق الادخال مع بعض الاعداداة الاخرى كتحكم بدقة الشاشة للعمل ينقصة تحديث للاستكمال 😇

4- اضافة تعديل شعار النظام وتسمية الوزارة او الشركة - والدولة Ar And En

5- لا يمكن اغلاق الا بحالتين بزر اغلاق او تاسك منجر

7- بداية الدخول تسجيل كلمة المرور وبتحديث استكمال

6-اضافة للنافذة غير منبثقة داخل النافذة للبحث والاستعلام المتعدد الكود

Dim MsG1                                 As String
Dim MsG2                                 As String
Dim MsG3                                 As String
Dim Save_value As String
'-=======-( Chack SQL Value k )
If DCount("*", "[Companey]") = 0 Then
'msgbox
MsG2 = "Sand Massage !": MsG1 = "تم الغاء تنفيذ استعلام والبحث ": MsG3 = " لا توجد بيانات ولا سجلات مضافة من الاصل 0 *! اضافة سجلات جديده ثم اعادة التنفيذ : او الاتصال بالمسؤل او المورد في حالة حدوث مشكلة "
    MyMsgBox (MsG3), (MsG2), (MsG1), msg_OK, Btn_Non, Arabic_Center ', True, 2.5
Exit Sub: End If

If Not IsNull(Me.SSHX) Then Me.Sexxo.SetFocus: Save_value = Me.SSHX: DoEvents: Form_ss_2.SHX = Me.SSHX:   DoEvents:   ': Form_ss_2.MainSub.SourceObject = "MF_0" Else: Exit Sub ': End If

If Me.Sexxo = "اسم الشركة" Then Form_ss_2.SHX = Me.SSHX:   DoEvents: Form_ss_2.MainSub.SourceObject = "MF_01": Exit Sub
If Me.Sexxo = "اسم المؤسس" Then Form_ss_2.SHX = Me.SSHX:    DoEvents: Form_ss_2.MainSub.SourceObject = "MF_02": Exit Sub
If Me.Sexxo = "رقم الترسية" Then Form_ss_2.SHX = Me.SSHX:    DoEvents: Form_ss_2.MainSub.SourceObject = "MF_03": Exit Sub
If Me.Sexxo = "موضوع المناقصة" Then Form_ss_2.SHX = Me.SSHX:    DoEvents: Form_ss_2.MainSub.SourceObject = "MF_04": Exit Sub
If Me.Sexxo = "المبلغ الاجمالي" Then Form_ss_2.SHX = Me.SSHX:    DoEvents: Form_ss_2.MainSub.SourceObject = "MF_05": Exit Sub

ولكن نسيت كود بدل من ضغط على الحقل مر اخرى قبل البحث للنقل قيمة الحقل مع تصحيحات اخرى :biggrin:

ويوجد نقط اخرى نسيتها مكثره حلو :biggrin2:

تحميل المرفق https://drive.google.com/file/d/1Frq3rpIsVYKGRzDpBQeW9A4LRH_CLkwS/view?usp=drive_link تابع الفيدو للتوضيح ومشاهدة ممتعة

hanan_ms · يناير 20

مكتبة كافة الادوات المساعدة والمميزة والكواد والمشاريع 2026-2027 Ms_hanan : https://sites.google.com/view/mas-projectss/home

لضم بعض الاعمال وتنزيل المباشر الكل مفتوح المصدر :wink2:

********************************************************************************************************

توسيــــع واستكمال :biggrin2:

1- اضافة اعدادة النسخة الاحتياطية مع التشغيل وتحديد عدد النسخ مع اخذ نسخة بشريط التقدم التأكد من الانتهاء ثم الاغلاق مع عرض النسخ والحذف الكل

+ استبدال النسخة في التحديث

فقط قواعد المشروع - فتحديث استكمال

2- اضافة قائمةالاعدادة تفاعلية عند التهئية جديد

بتحديث استكمال 😇

...

تابعوا الفيديو للتوضيح

https://drive.google.com/file/d/1ldmRGtBe8PRNNUvWCxH4XXSbPyZxkHkR/view?usp=drive_link

hanan_ms · يناير 24

مكتبة كافة الادوات المساعدة والمميزة والكواد والمشاريع 2026-2027 Ms_hanan : https://sites.google.com/view/mas-projectss/home

لضم بعض الاعمال وتنزيل المباشر من غير اذونات الكل مفتوح المصدر :wink2:

********************************************************************************************************

توسيــــع واستكمال :biggrin2:

1- اضافة فحص وتسجيل الجهاز عند الاقلاع بمفتاح الترخيص

سهل وسريع :

Private Sub Chack_Pc_Sruial()
'==========( Chack Into PC = PC K
If IsNull(DLookup("[CPU_Na]", "[PC_X_PC]")) Then Call Error_Chack_Pc_Sruial: Exit Sub
If IsNull(DLookup("[CPU_ma]", "[PC_X_PC]")) Then Call Error_Chack_Pc_Sruial: Exit Sub
If IsNull(DLookup("[CPU_se]", "[PC_X_PC]")) Then Call Error_Chack_Pc_Sruial: Exit Sub
If IsNull(DLookup("[Motherboard_se]", "[PC_X_PC]")) Then Call Error_Chack_Pc_Sruial: Exit Sub
If IsNull(DLookup("[Motherboard_ma]", "[PC_X_PC]")) Then Call Error_Chack_Pc_Sruial: Exit Sub
If IsNull(DLookup("[Motherboard_mo]", "[PC_X_PC]")) Then Call Error_Chack_Pc_Sruial: Exit Sub
If IsNull(DLookup("[Motherboard_Bi]", "[PC_X_PC]")) Then Call Error_Chack_Pc_Sruial: Exit Sub
If IsNull(DLookup("[HDD_se]", "[PC_X_PC]")) Then Call Error_Chack_Pc_Sruial: Exit Sub
If IsNull(DLookup("[HDD_na]", "[PC_X_PC]")) Then Call Error_Chack_Pc_Sruial: Exit Sub
If IsNull(DLookup("[HDD_mo]", "[PC_X_PC]")) Then Call Error_Chack_Pc_Sruial: Exit Sub

If DLookup("[CPU_Na]", "[PC_X_PC]", "[CPU_Na]=" & "'" & Me.txt1 & "'") = Me.txt1 Then Else: Call Error_Chack_Pc_Sruial: Exit Sub
If DLookup("[CPU_ma]", "[PC_X_PC]", "[CPU_ma]=" & "'" & Me.txt2 & "'") = Me.txt2 Then Else: Call Error_Chack_Pc_Sruial: Exit Sub
If DLookup("[CPU_se]", "[PC_X_PC]", "[CPU_se]=" & "'" & Me.txt3 & "'") = Me.txt3 Then Else: Call Error_Chack_Pc_Sruial: Exit Sub
If DLookup("[Motherboard_se]", "[PC_X_PC]", "[Motherboard_se]=" & "'" & Me.txt4 & "'") = Me.txt4 Then Else: Call Error_Chack_Pc_Sruial: Exit Sub
If DLookup("[Motherboard_ma]", "[PC_X_PC]", "[Motherboard_ma]=" & "'" & Me.txt5 & "'") = Me.txt5 Then Else: Call Error_Chack_Pc_Sruial: Exit Sub
If DLookup("[Motherboard_mo]", "[PC_X_PC]", "[Motherboard_mo]=" & "'" & Me.Txt6 & "'") = Me.Txt6 Then Else: Call Error_Chack_Pc_Sruial: Exit Sub
If DLookup("[Motherboard_Bi]", "[PC_X_PC]", "[Motherboard_Bi]=" & "'" & Me.Txt7 & "'") = Me.Txt7 Then Else: Call Error_Chack_Pc_Sruial: Exit Sub
If DLookup("[HDD_se]", "[PC_X_PC]", "[HDD_se]=" & "'" & Me.Txt8 & "'") = Me.Txt8 Then Else: Call Error_Chack_Pc_Sruial: Exit Sub
If DLookup("[HDD_na]", "[PC_X_PC]", "[HDD_na]=" & "'" & Me.Txt9 & "'") = Me.Txt9 Then Else: Call Error_Chack_Pc_Sruial: Exit Sub
If DLookup("[HDD_mo]", "[PC_X_PC]", "[HDD_mo]=" & "'" & Me.Txt10 & "'") = Me.Txt10 Then Else: Call Error_Chack_Pc_Sruial: Exit Sub

If Me.f_1.Visible = False Then Me.f_1.Visible = True
If Me.f_3.Visible = False Then Me.f_3.Visible = True
If Me.f_4.Visible = False Then Me.f_4.Visible = True
If Me.f_2.Visible = True Then Me.f_2.Visible = False

Me.f_3.BackColor = rgb(34, 177, 76)
Me.f_1.Caption = "الجهاز مرخيص ومفعل بجهة مالك مشــــــروع .. جاري التهيئة وضبط التصال الآلي "


End Sub

2- اخذ النسخالاحتياطية مباشر لقاعدة المشروع وقاعدة الادخال كل بنافذة الادخال عند قائم الاعدادت والضبط

3- تحسين في نافذة الادخال بعامود التحرك مع مؤشر التحديد + اضافة 37 قائمة ادخال 😇

Private Sub CmdFirstRecord_Click()
  On Error Resume Next
    If Me.Add_New_Mony_0.Form.Recordset.RecordCount > 0 Then
    Me.Add_New_Mony_0.Form.Recordset.MoveFirst
        Form_Add_New_Mony_0.IDD = Form_Add_New_Mony_0.ID
End If
End Sub
Private Sub CmdLastRecord_Click()
    On Error Resume Next
    If Me.Add_New_Mony_0.Form.Recordset.RecordCount > 0 Then
    Me.Add_New_Mony_0.Form.Recordset.MovePrevious
    Form_Add_New_Mony_0.IDD = Form_Add_New_Mony_0.ID
End If

End Sub
Private Sub CmdNextRecord_Click()
    On Error Resume Next
        If Me.Add_New_Mony_0.Form.Recordset.RecordCount > 0 Then
    Me.Add_New_Mony_0.Form.Recordset.MoveNext
        Form_Add_New_Mony_0.IDD = Form_Add_New_Mony_0.ID
End If

End Sub
Private Sub CmdPreviousRecord_Click()
    On Error Resume Next
    '================(last ?!
        If Me.Add_New_Mony_0.Form.Recordset.RecordCount > 0 Then
    Me.Add_New_Mony_0.Form.Recordset.MoveLast
        Form_Add_New_Mony_0.IDD = Form_Add_New_Mony_0.ID
End If

End Sub

- لان البعض حتى الان يستخدمون في نماذج المستمر للتنقل DoCmd.GoToRecord , "", acFirst ؟ ما خذين العامود السجلات بطول النافذه ويتسخدم الكود لنموذج منفرد 😇

4- استكمال وتصحيح اعدادة النسخ الاحتياطية ويحتاج الى تعديل :biggrin:

:::: تابعو الفيديو للتوضيح اكثر مشاهدة ممتعة

تحميل المباشر من غير اذونات

https://drive.google.com/file/d/1SpayGLtFKnKVoW-p0b5doZQ8zSL0R7cv/view?usp=drive_link

hanan_ms · يناير 26

مكتبة كافة الادوات المساعدة والمميزة والكواد والمشاريع 2026-2027 Ms_hanan : https://sites.google.com/view/mas-projectss/home

لضم بعض الاعمال وتنزيل المباشر من غير اذونات الكل مفتوح المصدر :wink2:

********************************************************************************************************

توسيــــع واستكمال :biggrin2:

1- اضافة اخذ الاحداثيات ولعرض التقرير الى كامل الشاشات مختلف الى شاشة بعرض الجدار مع ادوات التقرير

Private Sub Sreen_Give_Value()
On Error Resume Next ' =========== ( Abut If Name Object Form Or Report Error !~#
Dim Ttb3                      As Recordset
Dim strsq1                    As String
Dim strsq2                    As String
Dim strsq3                    As String
Dim Run_Update                As Integer
Dim MaxWidth                  As Long
Dim nss                       As String
Dim NsR                       As String
Dim Close_FR                  As Integer
'===============( IF Open Agen )=========
Dim Run_Up As Integer
Dim YYX As Long
Dim XXY As Long
Dim Rep As String
Dim XXX As LongLong

' اسم النموذج المحدد للتحقق انه مفتوح
nss = "Top_Report"
' اسم التقرير المحدد للتحقق انه مفتوح
NsR = Form_Top_Report.Name_report_X.Caption

If IsFormLoaded(nss) Then
Else
For Close_FR = 1 To 1
If IsReportLoaded(NsR) Then DoCmd.Close acReport, NsR Else: NsR = ""  ' تفريغ غير مفتوح
Next
DoCmd.Close acForm, nss
End If

'!~# Chack If IsNull Tablet TblRSR = Clane Record ! k
If DCount("*", "[TblRSR]") = 0 Then
        Set Ttb3 = CurrentDb.OpenRecordset("TblRSR")
        Ttb3.AddNew
        Ttb3![YY] = Me.YY.Caption
        Ttb3![xx] = Me.xx.Caption
        Ttb3![Today] = Now()
        Ttb3.Update
Else
       For Run_Update = 1 To 3
       If Run_Update = 1 Then
            strsq1 = "Update TblRSR Set YY = '" & Me.YY.Caption & "'"
            CurrentDb.Execute strsq1
            DoEvents
End If
 
        If Run_Update = 2 Then
            strsq2 = "Update TblRSR Set XX = '" & Me.xx.Caption & "'"
            CurrentDb.Execute strsq2
            DoEvents
End If

        If Run_Update = 3 Then
            strsq3 = "Update TblRSR Set Today = '" & Now() & "'"
            CurrentDb.Execute strsq3
            DoEvents
End If

Next Run_Update
End If
'!~#************************************( End Chack with Update )

If Me.f_1.Visible = False Then Me.f_1.Visible = True
If Me.f_4.Visible = False Then Me.f_4.Visible = True
If Me.f_3.Visible = False Then Me.f_3.Visible = True
If Me.f_2.Visible = True Then Me.f_2.Visible = False
'==========
Me.f_1.Caption = " تم اخذ احداثيات بنجــــــــــــاح بتحديث بحفظ آخر التعديلات والتأمين " & Now
Me.f_3.BackColor = rgb(23, 231, 137)

Me.YY.Caption = Me.InsideHeight
Me.xx.Caption = Me.InsideWidth

'*********( Agen Open Report with Tools)
If Me.Repo.Caption = "Repo" Then
 Pause 4#
       DoCmd.Close acForm, Me.Form.Name
Else
DoCmd.openForm nss

       Rep = NsR
       '===========( Number For Screen HD 1920 x 1080 Inch
       If IsNull(DLookup("[YY]", "[TblRSR]")) Then YYX = 2715 - DLookup("[YY]", "[TblRSR]") Else: YYX = DLookup("[YY]", "[TblRSR]")
       If IsNull(DLookup("[xx]", "[TblRSR]")) Then XXY = 28725 + 200 Else: XXY = DLookup("[xx]", "[TblRSR]")

       '===============( Only Value Caption
       DoCmd.openForm "Back_Size_0", , , , , acHidden
       Form_Back_Size_0.T_Form.Caption = Rep

       For Run_Up = 1 To 1
       DoCmd.ShowToolbar "Ribbon", acToolbarNo
       Next
       
       DoCmd.openForm "top_report"
       Form_Top_Report.Name_report_X.Caption = Rep

       DoCmd.openReport Rep, acViewPreview
       Reports(Rep).Move 0, 2000, XXY, YYX
        Pause 4#
       DoCmd.Close acForm, Me.Form.Name
End If

End Sub

2- اضافة عرض التقرير مع تحسين الادخال 😇

Private Sub report_Click()
Dim Rep               As String
Dim XXY               As Long
Dim YYX               As Long

'================( Only Name If Open Report)
       Rep = "n_x_n"
'***********************#

       '===========( Number For Screen HD 1920 x 1080 Inch To  Up More Size Screen )
       If IsNull(DLookup("[YY]", "[TblRSR]")) Then YYX = 12900 Else: YYX = 2715 - DLookup("[YY]", "[TblRSR]")
       If IsNull(DLookup("[xx]", "[TblRSR]")) Then XXY = 28725 + 200 Else: XXY = DLookup("[xx]", "[TblRSR]")
       
       '===============( Only Value Caption
       DoCmd.openForm "Back_Size_0", , , , , acHidden
       Form_Back_Size_0.T_Form.Caption = "n_x_n"

       For Run_Up = 1 To 1
       DoCmd.ShowToolbar "Ribbon", acToolbarNo
        Next
        '==========( Open If Need Filter or SQL )
       DoCmd.openForm "top_report"
       Form_Top_Report.Name_report_X.Caption = Rep

       DoCmd.openReport Rep, acViewPreview
       Reports(Rep).Move 0, 2000, XXY, YYX
End Sub

3-اضافة اعدادة ضبط الشاشة بدقة وبحجم الخط الويندوز وبارتفاع شريط الويندوز + عند التعديل اعاداة الويندوز تستكمل العمل تابع الفيديو للتوضيح

5- فحص المتغيرات كل ثانية

4- اضافة بيانات التأسيس عند الفتح ايضا تابع الفيديو

... :biggrin:

تحميل المرفق

https://drive.google.com/file/d/10xilWaBhr4Wqqc0pwpgePIN8ZHEl0mLL/view?usp=drive_link

hanan_ms · يناير 28

مكتبة كافة الادوات المساعدة والمميزة والكواد والمشاريع 2026-2027 Ms_hanan : https://sites.google.com/view/mas-projectss/home

لضم بعض الاعمال وتنزيل المباشر من غير اذونات الكل مفتوح المصدر :wink2:

********************************************************************************************************

توسيــــع واستكمال :biggrin2:

1- اضافة خيار الخلفية صوره او فيديو وكامل الشاشة HD

فقط الفيديو اما الصوره شاشة بحجم الجدار

2- اضافة واستكمال تسجيل الدخول التحقق من احرف الانجليزي الكبيره والصغيره بداله واحده مصغره فقط اسم المستخدم وكلمة المرورو 😇

'داله التحقق اذا كانت الاحرف كبيرة او لا
Public Function SameCasePattern(ByVal Txt1 As String, _
                                ByVal Txt2 As String) As Boolean

    Txt1 = Nz(Txt1, "")
    Txt2 = Nz(Txt2, "")

    ' الطول يجب أن يكون متساوي
    If Len(Txt1) <> Len(Txt2) Then
        SameCasePattern = False
        Exit Function
    End If

    ' مقارنة حساسة لحالة الأحرف
    SameCasePattern = (StrComp(Txt1, Txt2, vbBinaryCompare) = 0)

End Function
Public Function SameCasePattern_Name(ByVal Txt1 As String, _
                                ByVal Txt2 As String) As Boolean

    Txt1 = Nz(Txt1, "")
    Txt2 = Nz(Txt2, "")

    ' الطول يجب أن يكون متساوي
    If Len(Txt1) <> Len(Txt2) Then
        SameCasePattern_Name = False
        Exit Function
    End If

    ' مقارنة حساسة لحالة الأحرف
    SameCasePattern_Name = (StrComp(Txt1, Txt2, vbBinaryCompare) = 0)

End Function
Private Sub EX_3_Click()
Dim ftps                                 As String
'================( Chack Value Smoll Or capitl :
Dim DBValue_User                              As String
Dim DBValue_PWD                               As String

DBValue_User = Nz(DLookup("[User_Name]", "[User]", "[User_Name]='" & Form_into_logen.x1 & "'"), "")
DBValue_PWD = Nz(DLookup("[Password]", "[User]", "[User_Name]='" & Form_into_logen.x1 & "'"), "")

If IsNull(Form_into_logen.x1) Or Form_into_logen.x1 = "" Then
If Not Me.f_1.Width = Me.Form.InsideWidth Then Me.f_1.Width = Me.Form.InsideWidth
If Not Me.f_3.Width = Me.Form.InsideWidth Then Me.f_3.Width = Me.Form.InsideWidth
If Me.f_1.Visible = False Then Me.f_1.Visible = True
If Me.f_2.Visible = False Then Me.f_2.Visible = True
If Me.f_3.Visible = False Then Me.f_3.Visible = True
Me.f_1.Caption = " حقل المستخدم فارغ ؟! " & " - " & Now

Exit Sub
End If

If IsNull(Form_into_logen.x2) Or Form_into_logen.x2 = "" Then
If Not Me.f_1.Width = Me.Form.InsideWidth Then Me.f_1.Width = Me.Form.InsideWidth
If Not Me.f_3.Width = Me.Form.InsideWidth Then Me.f_3.Width = Me.Form.InsideWidth
If Me.f_1.Visible = False Then Me.f_1.Visible = True
If Me.f_2.Visible = False Then Me.f_2.Visible = True
If Me.f_3.Visible = False Then Me.f_3.Visible = True
Me.f_1.Caption = " حقل كلمة المرور فارغة ؟! " & " - " & Now

Exit Sub
End If

If Form_into_logen.x1 = DLookup("[User_Name]", "[User]", "[User_Name]='" & Form_into_logen.x1 & "'") Then
If Form_into_logen.x2 = DLookup("[Password]", "[User]", "[User_Name]='" & Form_into_logen.x1 & "'") Then

'فحص الاحرف EN
If SameCasePattern_Name(DBValue_User, Form_into_logen.x1) Then
If SameCasePattern(DBValue_PWD, Form_into_logen.x2) Then
'=========================( Yes )
If Me.f_1.Visible = True Then Me.f_1.Visible = False
If Me.f_2.Visible = True Then Me.f_2.Visible = False
If Me.f_3.Visible = True Then Me.f_3.Visible = False
'ftps = CurrentProject.Path & "\IMG_Size\" & DLookup("[User_Name]", "[user]", "[ID]='" & Me.ID & "'") & "_3.png"
ftps = CurrentProject.path & "\IMG_Size\" & Form_into_logen.x1 & "_3.png"
Me.tx.Caption = " Logen: مرحبا بك " & Form_into_logen.x1
If Not Dir(ftps) = "" Then Me.sx.Picture = ftps
Call zx_Click
Else
If Not Me.f_1.Width = Me.Form.InsideWidth Then Me.f_1.Width = Me.Form.InsideWidth
If Not Me.f_3.Width = Me.Form.InsideWidth Then Me.f_3.Width = Me.Form.InsideWidth
If Me.f_1.Visible = False Then Me.f_1.Visible = True
If Me.f_2.Visible = False Then Me.f_2.Visible = True
If Me.f_3.Visible = False Then Me.f_3.Visible = True
Me.f_1.Caption = " خطأ تسجيل الدخول تأكد من الاسم وكلمت المرور ثم عاود الحاولة ؟! " & " - " & Now

Exit Sub
End If
Else
If Not Me.f_1.Width = Me.Form.InsideWidth Then Me.f_1.Width = Me.Form.InsideWidth
If Not Me.f_3.Width = Me.Form.InsideWidth Then Me.f_3.Width = Me.Form.InsideWidth
If Me.f_1.Visible = False Then Me.f_1.Visible = True
If Me.f_2.Visible = False Then Me.f_2.Visible = True
If Me.f_3.Visible = False Then Me.f_3.Visible = True
Me.f_1.Caption = " خطأ تسجيل الدخول تأكد من الاسم وكلمت المرور ثم عاود الحاولة ؟! " & " - " & Now

Exit Sub
End If

End If
End If

End Sub

3- عرض التقرير بتقسيم بسيط جدا داخل كل تقرير حدث عند الفتح + كود بسيط في القائمة ادوات التقرير وكل ما زاد عن الف 1000 سجل اصبح 2 مع الطباعة الفورية ( لمعالجة الثقل وسرعة والسهولة سأحاول تجربته 😇

Private Sub nzV()
Dim rpt As String
Dim SourceSQL As String
Dim rpt_X As Report
Dim Give_itme As Integer
Dim N_R As Long

'جلب اسم مصدر التقرير كان جدول او استعلام
Set rpt_X = Reports(Me.Name_report_X.Caption)
SourceSQL = rpt_X.RecordSource


Me.sexo = Nz(DCount("*", SourceSQL), 0)

If Len(Nz(DCount("*", SourceSQL), 0)) < 3 Then
N_R = 1
Else
N_R = Right(Nz(DCount("*", Me.Name_report_X.Caption), 1), 4)
End If

Me.txtPageSize.RowSourceType = "Value List"

    With Me.txtPageSize
    For Give_itme = 1 To N_R
        .AddItem Give_itme
        Next
    End With
End Sub
  
 والكود داخل كل تقرير
  Option Compare Database

Private Sub Report_Load()
DoCmd.Maximize

If IsNull(DLookup("[IMG_1]", "[Ass]")) Then Me.PX_1.Visible = False
If IsNull(DLookup("[IMG_1]", "[Ass]")) Then Me.PX_2.Visible = False

End Sub
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)

    Dim Parts() As String
    Dim StartRow As Long, EndRow As Long
    
    ' قراءة النطاق من TAG
    If Me.Tag <> "" Then
        Parts = Split(Me.Tag, "|")
        StartRow = CLng(Parts(0))
        EndRow = CLng(Parts(1))
        
        ' إذا رقم السجل الحالي خارج النطاق ? اخفِه
        If Me.currentRecord < StartRow Or Me.currentRecord > EndRow Then
            Me.Visible = False
        Else
            Me.Visible = True
        End If
    End If

End Sub

Private Sub Report_Open(Cancel As Integer)
 Dim PageNumber As Long
    Dim PageSize As Long
    Dim StartRow As Long
    Dim EndRow As Long

    ' إعدادات
    PageSize = 1000   ' عدد السجلات لكل مجموعة
    PageNumber = Nz(Forms!Top_Report!txtPageSize, 1)  ' الحقل غير منضم في النموذج
    
    StartRow = (PageNumber - 1) * PageSize + 1
    EndRow = PageNumber * PageSize

    ' نحفظ النطاق في TAG التقرير لاستخدامه لاحقاً
    Me.Tag = StartRow & "|" & EndRow

End Sub

....

تابع الفيديو للتوضيح مشاهده ممتعة :biggrin:

تحميل المرفق

https://drive.google.com/file/d/1hF1CX00nJh0JmNowOzyPJVW-swPkAuWl/view?usp=drive_link

تسجيل الدخول

نموذج فرعي داخل صفحة رئيسية بقائمة جانبية

الردود الموصى بها

hanan_ms

hanan_ms

hanan_ms

hanan_ms

hanan_ms

hanan_ms

hanan_ms

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information