Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Nisan 2004 Cumartesi

Use CommandBar and CommandBarControl ID




'UserForm1

Option Explicit
Dim i As Integer
Dim CB As CommandBar
Dim CBC As CommandBarControl
Dim CBCAdı As String
Dim CBCDurumu As Variant
Dim Adet As Double

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®]Usable CommandBar and CommandBarControls"
ListBox1.ColumnCount = 3
ListBox1.ColumnWidths = "36;260;36"
TextBox1.Value = 10000
Adet = TextBox1.Value
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
If Adet <> 0 Then
Call Kullanıma_Aç
End If
End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
If Adet <> 0 Then
Call Kullanıma_Kapat
End If
End Sub
Private Sub TextBox1_Change()
On Error GoTo Hata:
Adet = TextBox1.Value
Exit Sub
Hata:
TextBox1.Value = 10000
Adet = TextBox1.Value
End Sub
Sub Kullanıma_Aç()
On Error Resume Next
ReDim Hafıza((Adet - 1), 3)
For i = 0 To (Adet - 1)
Kullanıma_Açıklık i, True
Hafıza(i, 0) = i
Hafıza(i, 1) = CBCAdı
Hafıza(i, 2) = CBCDurumu
Next i
ListBox1.List() = Hafıza()
End Sub
Sub Kullanıma_Kapat()
On Error Resume Next
ReDim Hafıza((Adet - 1), 3)
For i = 0 To (Adet - 1)
Kullanıma_Açıklık i, False
Hafıza(i, 0) = i
Hafıza(i, 1) = CBCAdı
Hafıza(i, 2) = CBCDurumu
Next i
ListBox1.List() = Hafıza()
End Sub
Sub Kullanıma_Açıklık(Id As Integer, Enabled As Boolean)
On Error GoTo Hata
For Each CB In Application.CommandBars
Set CBC = CB.FindControl(Id:=Id, Recursive:=True)
If Not CBC Is Nothing Then
CBC.Enabled = Enabled
CBCAdı = CBC.Caption
If Enabled = -1 Then
CBCDurumu = "True"
Else
CBCDurumu = "False"
End If
End If
Next CB
Hata:
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