اضافة حدث او امر لجميع النماذج دفعه واحده

[king5star]

السلام عليكم السؤال هو اننى اريد اضافة حدث لكل النماذج فى حدث عن التحميل اضافة كود فى بى

فى حدث عند التحميل والكود هو

call Color_V(me)

وللتسهيل لقد وجدت كود اضافة استاذى @صالح حمادي ببرنامج انشاء شريط القوائم ولم اتمكن من تديلة وكان هذا هو الكود :

DoCmd.OpenForm new_name, acDesign
   For i1 = 1 To nombre_subliste
      t = 0 + (453.5433070866) * (i1 - 1) ' الأعلى
      L = 0      ' اليسار

      Set crt = CreateControl(new_name, acCommandButton, acDetail, , , L, t, "1700.787401575", "453.5433070866")
      With crt
         .Caption = DLookup("[name_button]", "[tbl_sublist]", "[id_button]=" & i1 & "And[id_list]=" & i)
         .BackColor = 15918812
         .BorderColor = 15918812
         .name = "B" & i1
      End With

      str_code = "Private Sub " & "B" & i1 & "_Click()" & vbCrLf & _
      "forms!" & form_name & "!sublist" & i & ".Height = 0" & vbCrLf & _
      DLookup("[code_button]", "tbl_sublist", "[id_button]=" & i1 & "And[id_list]=" & i) & vbCrLf & _
      "End Sub"
      Forms(new_name).Module.AddFromString str_code
 
      str_code = "Private Sub " & "B" & i1 & "_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)" & vbCrLf & _
      "if me.B" & i1 & ".BackColor = 15918812 then" & vbCrLf & _
      ""
      For i2 = 1 To nombre_subliste
         If i2 = i1 Then
           str_code = str_code & "me.B" & i2 & ".BackColor=15849926" & vbCrLf & _
           ""
         Else
           str_code = str_code & "me.B" & i2 & ".BackColor=15918812" & vbCrLf & _
           ""
         End If
      Next i2
      
      str_code = str_code & "end if" & vbCrLf & _
      "end sub"
      Forms(new_name).Module.AddFromString str_code
   
   Next i1
   DoCmd.close acForm, new_name, acSaveYes

فهل من مساعده ؟

[صالح حمادي]

السلام عليكم

تفضل أخي هذا هو الكود

Dim str_code As String
Dim name_frm As String
Dim frm As AccessObject, dbs As Object

Set dbs = Application.CurrentProject

   For Each frm In dbs.AllForms
     name_frm = frm.Name
     
     DoCmd.OpenForm name_frm, acDesign
     
     str_code = "Private Sub Form_Load()" & vbCrLf & _
     "call Color_V(me)" & vbCrLf & _
     "end sub"
     Forms(name_frm).Module.AddFromString str_code
     DoCmd.Close acForm, name_frm, acSaveYes
   Next

 

[king5star]

2 minutes ago, صالح حمادي said:

السلام عليكم

تفضل أخي هذا هو الكود

Dim str_code As String
Dim name_frm As String
Dim frm As AccessObject, dbs As Object

Set dbs = Application.CurrentProject

   For Each frm In dbs.AllForms
     name_frm = frm.Name
     
     DoCmd.OpenForm name_frm, acDesign
     
     str_code = "Private Sub Form_Load()" & vbCrLf & _
     "call Color_V(me)" & vbCrLf & _
     "end sub"
     Forms(name_frm).Module.AddFromString str_code
     DoCmd.Close acForm, name_frm, acSaveYes
   Next

 

فينك من زمان استاذى @صالح حمادي والله الله ينور وربنا يباركلك ويوفقك اشتغل تمام التمام وجزاك الله خيراً .

[صالح حمادي]

11 ساعات مضت, king5star said:

فينك من زمان استاذى @صالح حمادي والله الله ينور وربنا يباركلك ويوفقك اشتغل تمام التمام وجزاك الله خيراً .

أهلين أخي @king5star الحمد لله أن الكود نجح معاك

سبب غيابي هو كثرة ضغط العمل و مرض الوالد شفاه الله فأنا الآن أقوم بجميع أعماله

[king5star]

1 minute ago, صالح حمادي said:

أهلين أخي @king5star الحمد لله أن الكود نجح معاك

سبب غيابي هو كثرة ضغط العمل و مرض الوالد شفاه الله فأنا الآن أقوم بجميع أعماله

اعانك الله وعفا عن الوالد وشفاه ووفقك فى كل عملك واعمالك .

[king5star]

مثال تطبيقي

db1.zip