Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Aralık 2004 Pazartesi

Worksheet Selection Change


'Sheets("VeriTabanı") Module

Option Explicit
Dim Satır, Sütun As Integer
Dim Satırım, Sütunum, Hücrem, Seçimim As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If (Selection.Cells.Count > 1) Then Exit Sub
Application.EnableEvents = False
Satır = ActiveCell.Row
Sütun = ActiveCell.Column
Set Hücrem = ActiveCell
Set Satırım = Range(Cells(Satır, 1), Cells(Satır, Sütun + 1))
Set Sütunum = Range(Cells(1, Sütun), Cells(Satır + 1, Sütun))
Set Seçimim = Application.Union(Satırım, Sütunum)
Seçimim.Select
Hücrem.Activate
Set Hücrem = Nothing
Set Satırım = Nothing
Set Sütunum = Nothing
Set Seçimim = Nothing
Application.EnableEvents = True
End Sub

10 Aralık 2004 Cuma

Sheet, ListBox, TextBox Connection



'UserForm1

Option Explicit
Dim i As Integer
Dim Adet, No As Double

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Sheet, ListBox, TextBox Connection..."
Sheets("VeriTabanı").Select
Adet = Application.WorksheetFunction.Count(Range("A2:A100"))
With ListBox1
.ColumnCount = 4
.ColumnWidths = "30;48;72;72"
.RowSource = "VeriTabanı!A2:D" & Adet + 1
.ListIndex = 0
End With
End Sub
Private Sub ListBox1_Change()
On Error Resume Next
No = ListBox1.ListIndex
For i = 0 To (4 - 1)
Me("TextBox" & (i + 1)).Text = ListBox1.List(i, 0)
Next i
Sheets("VeriTabanı").Range(Cells(No + 2, 1), Cells((No + 2), 4)).Select
End Sub
Private Sub ListBox1_Click()
On Error Resume Next
No = ListBox1.ListIndex
TextBox1.Text = ListBox1.List(No, 0)
TextBox2.Text = ListBox1.List(No, 1)
TextBox3.Text = ListBox1.List(No, 2)
TextBox4.Text = ListBox1.List(No, 3)
Sheets("VeriTabanı").Range(Cells(No + 2, 1), Cells((No + 2), 4)).Select
End Sub

1 Aralık 2004 Çarşamba

TextBox Cut/Copy Paste Control





'UserForm1

Dim Kontrol As Double

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] TextBox Cut/Copy Paste Control..."
TextBox1.Text = "Cut Copy Veri"
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
Kontrol = 0
With TextBox1
.SetFocus
.SelStart = 0
.SelLength = VBA.Len(.Text)
Kontrol = .SelLength
.EnterFieldBehavior = fmEnterFieldBehaviorSelectAll
.Copy
If (Kontrol > 0) Then
TextBox2.Paste
End If
End With
End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
Kontrol = 0
With TextBox1
.SetFocus
.SelStart = 0
.SelLength = VBA.Len(.Text)
Kontrol = .SelLength
.EnterFieldBehavior = fmEnterFieldBehaviorSelectAll
.Cut
If (Kontrol > 0) Then
TextBox2.Paste
End If
End With
End Sub

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