menü makrosunu otomatik açıp kapatmak

[aydgur]

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("A.G.CARİ")


Satir = 2
Do Until IsEmpty(MSayfa.Cells(Satir, 2))
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 MenuSil3()
Dim MSayfa As Worksheet
Dim Satir As Integer
Dim Baslik As String
On Error Resume Next
Set MSayfa = ThisWorkbook.Sheets("A.G.CARİ")
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
Bu menünün dosya ile beraber otomatik açılıp kapatılması için nasıl ekleme yapabilirim ? teşekkürler.

 

[Levent Menteşoğlu]

Menü hazırlamayı aşağıdaki gibi bir auto_open makrosuna, menü silmeyide bir auto_close makrosuna yazın.

[vb:1:1fe964dcb1]sub auto_open()
.
.kodlarınız
.
end sub[/vb:1:1fe964dcb1]

[vb:1:1fe964dcb1]sub auto_close()
.
.kodlarınız
.
end sub[/vb:1:1fe964dcb1]