Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Ekim 2007 Cumartesi

MS Office Excel® Dialogs




'UserForm1

Option Explicit
Dim x, y As Single
Dim Alan(1 To 137, 1 To 3)
Dim Sayfa, Adı

Private Sub UserForm_Initialize()
On Error Resume Next
With Me
.Width = 354 + 6 + 6 + 6
.Height = 152
.Caption = "[PBİD®] Liste üzerinden dialog çağırınız..."
End With
For Each Sayfa In ThisWorkbook.Sheets
If Sayfa.Name = "Dialoglar" Then
Adı = Sayfa.Name
Exit For
Else
Adı = Sayfa.Name
End If
Next Sayfa
If Adı <> "Dialoglar" Then
ThisWorkbook.Sheets.Add Sheets(1), , 1
ThisWorkbook.Sheets(1).Name = "Dialoglar"
Call Excel_Dialog_Pencereleri
Else
Call Excel_Dialog_Pencereleri
End If
For x = 1 To 137
Alan(x, 1) = Sheets("Dialoglar").Cells(x + 1, 1).Value
Alan(x, 2) = Sheets("Dialoglar").Cells(x + 1, 2).Value
Alan(x, 3) = Sheets("Dialoglar").Cells(x + 1, 3).Value
Next x
With ListBox1
.Left = 6
.Top = 6
.Height = 118
.Width = 354
.ColumnCount = 3
.ColumnWidths = "24;152;152"
.BackColor = &H80000018
.Clear
.List() = Alan()
End With
End Sub
Private Sub ListBox1_Click()
On Error GoTo Hata:
y = ListBox1.ListIndex + 1
If y >= -1 Then
Application.Dialogs(y).Show
End If
Hata:
Select Case Err
Case 18
Exit Sub
Case Else
Resume Next
End Select
End Sub
Sub Excel_Dialog_Pencereleri()
On Error GoTo Hata:
With Application
.EnableCancelKey = xlErrorHandler
For x = 1 To 137
Sheets("Dialoglar").Cells(x + 1, 1) = x
Sheets("Dialoglar").Cells(x + 1, 2) = .Dialogs(x).Application.CommandBars.Item(x).Name
Sheets("Dialoglar").Cells(x + 1, 3) = .Dialogs(x).Application.CommandBars.Item(x).NameLocal
.StatusBar = x
Next
.StatusBar = False
End With
Exit Sub
Hata:
Select Case Err
Case 18
Exit Sub
Case Else
Resume Next
End Select
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