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

[hanan_ms]

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

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

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

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

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]

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

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

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

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

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]

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

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

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

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

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

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

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

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

 

 

[hanan_ms]

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

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

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

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

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

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

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

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

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

...

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

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

 

[hanan_ms]

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

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

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

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

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- استكمال وتصحيح اعدادة النسخ الاحتياطية ويحتاج الى تعديل 

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

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

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

 

[hanan_ms]

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

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

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

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

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- اضافة بيانات التأسيس عند الفتح ايضا تابع الفيديو 

... 

تحميل المرفق

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