Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Ocak 2006 Cuma

To Use CommandBars(1) on UserForm1




'UserForm1

Private i As Single, ii As Single, iii As Single

Private ActiveX(3) As Control
Private ActiveXKontrol(3) As String
Private Menü As CommandBar
Private Ana As CommandBarControl
Private Alt As CommandBarControl
Private Tali As CommandBarControl
Private IDTip As Variant
Private IDNo As Variant
Private IDMenü As CommandBar
Private IDKontrol As CommandBarControl
Private ListeKontrol As Double

Private Sub UserForm_Initialize()
On Error Resume Next
With Me
.Caption = "[PBİD ®] CommandBars(1) Seçenekleri"
.Height = 162
.Width = 282
End With
ActiveXKontrol(1) = "Forms.ListBox.1"
Set ActiveX(1) = Me.Controls.Add(ActiveXKontrol(1))
With ActiveX(1)
.Name = "UserForm1"
.Top = 6
.Left = 6
.Width = 264
.Height = 108
.ColumnCount = 3
.ColumnWidths = "180;36;36"
.BackColor = &H80000018
.SpecialEffect = 3
.ControlTipText = "PopUp Menüden Çıkmak İçin Esc Düğmesine Basınız"
End With
ActiveXKontrol(2) = "Forms.Label.1"
Set ActiveX(2) = Me.Controls.Add(ActiveXKontrol(2))
With ActiveX(2)
.Top = 114
.Left = 6
.Width = 216
.Height = 18
.Caption = " Seçilen Menü ID No"
.SpecialEffect = 3
.BackColor = &H80000018
End With
ActiveXKontrol(3) = "Forms.Label.1"
Set ActiveX(3) = Me.Controls.Add(ActiveXKontrol(3))
With ActiveX(3)
.Top = 114
.Left = 222
.Width = 48
.Height = 18
.Caption = ""
.SpecialEffect = 3
.BackColor = &H80000018
.TextAlign = 2
End With
Set Menü = Application.CommandBars(1)
i = 0
For Each Komut1 In Menü.Controls
i = i + 1
Set Ana = Menü.Controls(i)
Komut = Ana.Caption
ActiveX(1).AddItem Komut
ActiveX(1).List(ActiveX(1).ListCount - 1, 1) = Ana.Type
ActiveX(1).List(ActiveX(1).ListCount - 1, 2) = Ana.ID
If Ana.Type = 10 Then
ii = 0
For Each Komut2 In Ana.Controls
ii = ii + 1
Set Alt = Ana.Controls(ii)
Komut2 = Alt.Caption
ActiveX(1).AddItem " " & Komut2
ActiveX(1).List(ActiveX(1).ListCount - 1, 1) = Alt.Type
ActiveX(1).List(ActiveX(1).ListCount - 1, 2) = Alt.ID
If Alt.Type = 10 Then
iii = 0
For Each Komut3 In Alt.Controls
iii = iii + 1
Set Tali = Alt.Controls(iii)
Komut3 = Tali.Caption
ActiveX(1).AddItem " " & Komut3
ActiveX(1).List(ActiveX(1).ListCount - 1, 1) = Tali.Type
ActiveX(1).List(ActiveX(1).ListCount - 1, 2) = Tali.ID
                                               Next Komut3
End If
Next Komut2
End If
Next Komut1
ListeKontrol = 1
End Sub
Private Sub UserForm_Activate()
On Error Resume Next
Do While ListeKontrol = 1
If ActiveX(1).ListIndex <> -1 Then
IDTip = ActiveX(1).List(ActiveX(1).ListIndex, 1)
IDNo = ActiveX(1).List(ActiveX(1).ListIndex, 2)
If (ActiveX(3).Caption <> IDNo) Then
ActiveX(3).Caption = IDNo
Set IDMenü = Application.CommandBars.Add("", msoBarPopup, , True)
Set IDKontrol = IDMenü.Controls.Add(IDTip, IDNo, , , True)
IDMenü.ShowPopup
End If
End If
DoEvents
Loop
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
ListeKontrol = 0
Unload Me
End Sub

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul