اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


king5star
إذهب إلى أفضل إجابة Solved by صالح حمادي,

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

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

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

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

 

  • Like 3
  • Thanks 1
رابط هذا التعليق
شارك

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

 

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

  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

رابط هذا التعليق
شارك

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

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

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

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

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • اضف...

Important Information