özel menüyü otomatik açıp kapatmak

Katılım
30 Ekim 2004
Mesajlar
38
Tüm yardımlarınız için müteşekkürüm ;böyle bir bilgiyi kıskanmadan paylaşmak ne güzel.
Excell deki özel menü o dosya açılınca açılıp dosyayı kapatınca otomatik kapansın istiyorum aşağıdaki makroya ne eklemek gerekir ?


Sub MenuHazirla1()
Dim MSayfa As Worksheet
Dim MNesne As CommandBarPopup
Dim MOge As Object
Dim AltMOge As CommandBarButton
Dim satir As Integer
Dim MDuzey, SDuzey, PozMakro, Baslik, Bolucu, FaceId

Set MSayfa = ThisWorkbook.Sheets("menuSayfasi")

Call MenuSil
satir = 2
Do Until IsEmpty(MSayfa.Cells(satir, 1))
MDuzey = MSayfa.Cells(satir, 1)
Baslik = MSayfa.Cells(satir, 2)
PozMakro = MSayfa.Cells(satir, 3)
Bolucu = MSayfa.Cells(satir, 4)
FaceId = MSayfa.Cells(satir, 5)
SDuzey = MSayfa.Cells(satir + 1, 1)
Select Case MDuzey
Case 1
Set MNesne = Application.CommandBars(1).Controls.Add(Type:=msoControlPopup, before:=PozMakro, Temporary:=True)
MNesne.Caption = Baslik
Case 2
If SDuzey = 3 Then
Set MOge = MNesne.Controls.Add(Type:=msoControlPopup)
Else
Set MOge = MNesne.Controls.Add(Type:=msoControlButton)
MOge.OnAction = PozMakro
End If
MOge.Caption = Baslik
If FaceId <> "" Then MOge.FaceId = FaceId
If Bolucu Then MOge.BeginGroup = True
Case 3
Set AltMOge = MOge.Controls.Add(Type:=msoControlButton)
AltMOge.Caption = Baslik
AltMOge.OnAction = PozMakro
If FaceId <> "" Then AltMOge.FaceId = FaceId
If Bolucu Then AltMOge.BeginGroup = True
End Select
satir = satir + 1
Loop
End Sub
Sub MenuSil1()
Dim MSayfa As Worksheet
Dim satir As Integer
Dim Baslik As String
On Error Resume Next
Set MSayfa = ThisWorkbook.Sheets("MenuSayfasi")
satir = 2
Do Until IsEmpty(MSayfa.Cells(satir, 1))
If MSayfa.Cells(satir, 1) = 1 Then
Baslik = MSayfa.Cells(satir, 2)
Application.CommandBars(1).Controls(Baslik).Delete
End If
satir = satir + 1
Loop
On Error GoTo 0
End Sub
 
Üst