مساعدة حول ربط ماكرو بزر تحكم within a frame activex

[عبدالله احمد سعيد]

السلام عليكم

رجائي من الاخوة مساعدتي في كيفية ربط command button داخل frame activex بماكرو يعرض رسالة ترحيب

حيث ان المطور يعرض فقط الحدث الخاص ب frame  اما زر التحكم فكأنه غير موجود 

Book1.xlsm

[omar elhosseini]

اعد التحميل

الملف الاول 

تم استخدام عناصر تحكم النموذج بدلا من استخدام  عناصر تحكم  ActiveX

الملف الثاني

لم ينم الانشاء من عناصر تحكم النموذج او عناصر تحكم  ActiveX

بل تم انشاء الفرام والزر بأستخدام   Crate Object.Controls عن طريق انشائهم بواسطة  Module وبمساعدة  Class

كود Module1

Dim objButtons(1 To 1) As New Class1
 
Sub Add_Frame()
With ActiveSheet.OLEObjects
  .Delete
  With .Add(ClassType:="Forms.Frame.1", Link:=False, DisplayAsIcon:=False)
    .Name = "Frame1"
    .Left = 400
    .Top = 75
    .Width = 200
    .Height = 75
    With .Object.Controls.Add("Forms.CommandButton.1", "cmdButton1", True)
      .Caption = "OK"
      .Left = 5
      .Top = 5
      .Width = 75
      .Height = 30
    End With
  End With
End With
Application.OnTime Now, "SetOnAction"
'
End Sub
 
Private Sub SetOnAction()
'
Dim x As Control
For Each x In ActiveSheet.OLEObjects(1).Object.Controls
  If TypeOf x Is MSForms.CommandButton Then
    i = i + 1
    Set objButtons(i).CmdBtn = x
  End If
Next

On Error Resume Next
If ActiveWorkbook.Sheets.Count = 1 Then
  Application.DisplayAlerts = False
  ActiveWorkbook.Sheets.Add.Delete
  Application.DisplayAlerts = True
Else
  With ActiveSheet
    .Next.Activate
    .Activate
  End With
End If
'
End Sub

 

كود Class1

Public WithEvents CmdBtn As MSForms.CommandButton
 
Private Sub CmdBtn_Click()
'
Select Case Me.CmdBtn.Caption
Case "Ok"
Case Else
  MsgBox "Hello"
End Select
'
End Sub

مع استخدام حدث Workbook_Open

لعمل اضافة الفرام والزر عند فتح الملف

ولا توجد طريقة لأستخدام Frame سوي هاتين الططريقتين

Private Sub Workbook_Open()
'
Add_Frame
'
End Sub

ومن الاسهل لك لتطويع الكود الطريقة الاولي بملف  Test_1

 

 

 

Test_1.xlsb Test_2.xlsb

[عبدالله احمد سعيد]

شكرا جزيلا لك استاذ .. كفيت و وفيت

آسف لإزعاجك و لكن هلا رفعت ملفي العمل بدون ضغط ... فرغم تحميلي المتكرر لهما الا ان الملف يكون دوما معطوبا و لا يفتح عندي

لابد من تحديث برنامج فك الضغط لديك

تم رفع الملفات بدون ضغط

 

[omar elhosseini]

اعد التحميل

 

 

Test_1.xlsm Test_2.xlsm

[عبدالله احمد سعيد]

شكرا لسعة صدرك استاذ