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

20 Kasım 2004 Cumartesi

TextBox Exit Control






'UserForm1

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] TextBox Exit Control..."
TextBox1.Text = "Türkiye"
Label2.Caption = ""
End Sub
Private Sub TextBox1_Change()
On Error Resume Next
CommandButton1.Enabled = True
Label2.Caption = ""
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
If (TextBox1 <> "Türkiye") Then
CommandButton1.Enabled = False
Label2.Caption = "Hatalı Kayıt"
Label2.ForeColor = &HFF&
Cancel = True
TextBox1.SetFocus
Else
Label2.Caption = "Başarılı Kayıt"
Label2.ForeColor = &HC000&
End If
End Sub

10 Kasım 2004 Çarşamba

Cells Find xlByRow



'UserForm1

Option Explicit
Dim Aranan As Variant
Dim Satır As Double

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Cells Find xlByRow..."
TextBox1.Text = "Erzurum"
Me.Show 0
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
Aranan = TextBox1.Value
Satır = Cells.Find(Aranan, Range("A1"), xlFormulas, xlPart, xlByRows, xlNext, False, False).Row
Range("A" & Satır & ":D" & Satır).Select
End Sub

1 Kasım 2004 Pazartesi

Cells Find on TextBox




'UserForm1

Option Explicit
Dim i As Byte
Dim BulunanSayfa, BulunanHücre, Aranan, ÖnDeğer, SonDeğer As Variant
Dim Hücre As Range
Dim No, Sayaç As Double

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Cells Find..."
With ComboBox1
.ColumnCount = 4
.ColumnWidths = "18;96;36;12"
.ListWidth = (18 + 96 + 36 + 12)
.Width = 36
End With
TextBox1.Text = "Erzurum"
End Sub
Private Sub ComboBox1_Click()
On Error Resume Next
No = ComboBox1.ListIndex
BulunanSayfa = ComboBox1.List(No, 1)
Label2.Caption = " " & BulunanSayfa
BulunanHücre = ComboBox1.List(No, 2)
Label3.Caption = BulunanHücre
Sheets(BulunanSayfa).Select
Range(BulunanHücre).Select
End Sub
Private Sub TextBox1_Change()
On Error Resume Next
Aranan = TextBox1.Value
If (VBA.Len(Aranan) > 0) Then
ÖnDeğer = Empty: SonDeğer = Empty:
Set Hücre = Nothing
ComboBox1.Clear
Sayaç = 0
For i = 1 To Worksheets.Count
Call TerimBulucu(Worksheets(i).Name)
Next i
End If
End Sub
Private Function TerimBulucu(Sayfa As String)
On Error Resume Next
Set Hücre = Sheets(Sayfa).Cells.Find(Aranan, LookIn:=xlValues)
If Not Hücre Is Nothing Then
SonDeğer = Hücre.Address
Do
Set Hücre = Sheets(Sayfa).Cells.FindNext(Hücre)
ÖnDeğer = Hücre.Address
Sayaç = Sayaç + 1
ComboBox1.AddItem Sayaç
ComboBox1.List(Sayaç - 1, 1) = Sayfa
ComboBox1.List(Sayaç - 1, 2) = ÖnDeğer
Loop While Not Hücre Is Nothing And (ÖnDeğer <> SonDeğer)
End If
End Function

20 Ekim 2004 Çarşamba

TextBox vbTextCompare

 
 
'UserForm1

'Additional Tools; TextBox1, Listbox1, Label1, TextBox2
Option Explicit
Dim Sayaç As Double
Dim YerNo As Integer
Dim Metin As String
Dim Aranan As String
Dim No As Double
Private Sub UserForm_Initialize()
    On Error Resume Next
    Me.Caption = "[PBİD®] vbTextCompare..."
    Call Ekran_Kur
    TextBox1.Text = "Erzurum"
End Sub
Private Sub TextBox1_Change()

    On Error GoTo Hata:
    ListBox1.Clear
    Sayaç = 0
    Label1.Caption = ""
    Metin = TextBox2.Text
    TextBox2.Text = Application.WorksheetFunction.Substitute(Metin, vbCrLf, " ")
    Metin = TextBox2.Text
    Aranan = TextBox1.Value
Durak1:
    YerNo = VBA.InStr(YerNo + 1, Metin, Aranan, vbTextCompare)
    If YerNo > 0 Then
        ListBox1.AddItem (Sayaç + 1)
        ListBox1.List(ListBox1.ListCount - 1, 1) = YerNo
        Sayaç = (Sayaç + 1)
        GoTo Durak1
    End If
    Exit Sub
Hata:
    ListBox1.Clear
    YerNo = 0
    Sayaç = 0
    Label1.Caption = ""
End Sub
Private Sub listbox1_Change()

    On Error GoTo Hata:
    No = ListBox1.ListIndex
    YerNo = ListBox1.List(No, 1)
    Label1.Caption = " " & YerNo & "-" & YerNo + VBA.Len(TextBox1.Text) - 1
    With TextBox2
        .SetFocus
        .SelStart = YerNo - 1
        .SelLength = VBA.Len(Aranan)
        .EnterFieldBehavior = fmEnterFieldBehaviorSelectAll
    End With
    Exit Sub
Hata:
    ListBox1.Clear
    YerNo = 0
    Sayaç = 0
    Label1.Caption = ""
End Sub
Private Sub Ekran_Kur()

    On Error Resume Next
    With Me
        .Height = 172
        .Width = 472
        .BackColor = VBA.RGB(242, 242, 242)
    End With
    With TextBox1
        .Left = 6
        .Top = 6
        .Height = 18
        .Width = 96
        .SpecialEffect = fmSpecialEffectEtched
        .ForeColor = vbBlue
        .ControlTipText = "Lütfen aramak istediğiniz terimi yazınız [Please enter the term you want to search]."
    End With
    With ListBox1
        .Left = 6
        .Top = 30
        .Height = 90
        .Width = 96
        .ColumnCount = 2
        .ColumnWidths = "36;48"
        .ListWidth = 84
        .SpecialEffect = fmSpecialEffectEtched
    End With
    With Label1
        .Left = 6
        .Top = 126
        .Height = 18
        .Width = 96
        .SpecialEffect = fmSpecialEffectEtched
        .Caption = ""
    End With
    With TextBox2
        .Left = 108
        .Top = 6
        .Height = 138
        .Width = 354
        .SpecialEffect = fmSpecialEffectEtched
        .MultiLine = True
        .ScrollBars = fmScrollBarsVertical
        .EnterKeyBehavior = True
        .Text = "Ankara"
        .Text = .Text & " " & "İstanbul"
        .Text = .Text & " " & "Manisa"
        .Text = .Text & " " & "Hakkari"
        .Text = .Text & " " & "Bursa"
        .Text = .Text & " " & "Trabzon"
        .Text = .Text & " " & "Erzurum"
        .Text = .Text & " " & "Antalya"
        .Text = .Text & " " & "Malatya"
        .Text = .Text & " " & "Denizli"
        .Text = .Text & " " & "Sivas"
        .Text = .Text & " " & "Edirne"
        .Text = .Text & " " & "Kahramanmaraş"
        .Text = .Text & " " & "Balıkesir"
        .Text = .Text & " " & "Muş"
        .Text = .Text & " " & "Yozgat"
        .Text = .Text & " " & "Muğla"
        .Text = .Text & " " & "Rize"
        .Text = .Text & " " & "Konya"
        .Text = .Text & " " & "Zonguldak"
        .Text = .Text & " " & "Ankara"
        .Text = .Text & " " & "İstanbul"
        .Text = .Text & " " & "Manisa"
        .Text = .Text & " " & "Hakkari"
        .Text = .Text & " " & "Bursa"
        .Text = .Text & " " & "Trabzon"
        .Text = .Text & " " & "Erzurum"
        .Text = .Text & " " & "Antalya"
        .Text = .Text & " " & "Malatya"
        .Text = .Text & " " & "Denizli"
        .Text = .Text & " " & "Sivas"
        .Text = .Text & " " & "Edirne"
        .Text = .Text & " " & "Kahramanmaraş"
        .Text = .Text & " " & "Balıkesir"
        .Text = .Text & " " & "Muş"
        .Text = .Text & " " & "Yozgat"
        .Text = .Text & " " & "Muğla"
        .Text = .Text & " " & "Rize"
        .Text = .Text & " " & "Konya"
        .Text = .Text & " " & "Zonguldak"
        .Text = .Text & " " & "Ankara"
        .Text = .Text & " " & "İstanbul"
        .Text = .Text & " " & "Manisa"
        .Text = .Text & " " & "Hakkari"
        .Text = .Text & " " & "Bursa"
        .Text = .Text & " " & "Trabzon"
        .Text = .Text & " " & "Erzurum"
        .Text = .Text & " " & "Antalya"
        .Text = .Text & " " & "Malatya"
        .Text = .Text & " " & "Denizli"
        .Text = .Text & " " & "Sivas"
        .Text = .Text & " " & "Edirne"
        .Text = .Text & " " & "Kahramanmaraş"
        .Text = .Text & " " & "Balıkesir"
        .Text = .Text & " " & "Muş"
        .Text = .Text & " " & "Yozgat"
        .Text = .Text & " " & "Muğla"
        .Text = .Text & " " & "Rize"
        .Text = .Text & " " & "Konya"
        .Text = .Text & " " & "Zonguldak"
        .Text = .Text & " " & "Ankara"
        .Text = .Text & " " & "İstanbul"
        .Text = .Text & " " & "Manisa"
        .Text = .Text & " " & "Hakkari"
        .Text = .Text & " " & "Bursa"
        .Text = .Text & " " & "Trabzon"
        .Text = .Text & " " & "Erzurum"
        .Text = .Text & " " & "Antalya"
        .Text = .Text & " " & "Malatya"
        .Text = .Text & " " & "Denizli"
        .Text = .Text & " " & "Sivas"
        .Text = .Text & " " & "Edirne"
        .Text = .Text & " " & "Kahramanmaraş"
        .Text = .Text & " " & "Balıkesir"
        .Text = .Text & " " & "Muş"
        .Text = .Text & " " & "Yozgat"
        .Text = .Text & " " & "Muğla"
        .Text = .Text & " " & "Rize"
        .Text = .Text & " " & "Konya"
        .Text = .Text & " " & "Zonguldak"
        .Text = .Text & " " & "Ankara"
        .Text = .Text & " " & "İstanbul"
        .Text = .Text & " " & "Manisa"
        .Text = .Text & " " & "Hakkari"
        .Text = .Text & " " & "Bursa"
        .Text = .Text & " " & "Trabzon"
        .Text = .Text & " " & "Erzurum"
        .Text = .Text & " " & "Antalya"
        .Text = .Text & " " & "Malatya"
        .Text = .Text & " " & "Denizli"
        .Text = .Text & " " & "Sivas"
        .Text = .Text & " " & "Edirne"
        .Text = .Text & " " & "Kahramanmaraş"
        .Text = .Text & " " & "Balıkesir"
        .Text = .Text & " " & "Muş"
        .Text = .Text & " " & "Yozgat"
        .Text = .Text & " " & "Muğla"
        .Text = .Text & " " & "Rize"
        .Text = .Text & " " & "Konya"
        .Text = .Text & " " & "Zonguldak"
        .Text = .Text & " " & "Ankara"
        .Text = .Text & " " & "İstanbul"
        .Text = .Text & " " & "Manisa"
        .Text = .Text & " " & "Hakkari"
        .Text = .Text & " " & "Bursa"
        .Text = .Text & " " & "Trabzon"
        .Text = .Text & " " & "Erzurum"
        .Text = .Text & " " & "Antalya"
        .Text = .Text & " " & "Malatya"
        .Text = .Text & " " & "Denizli"
        .Text = .Text & " " & "Sivas"
        .Text = .Text & " " & "Edirne"
        .Text = .Text & " " & "Kahramanmaraş"
        .Text = .Text & " " & "Balıkesir"
        .Text = .Text & " " & "Muş"
        .Text = .Text & " " & "Yozgat"
        .Text = .Text & " " & "Muğla"
        .Text = .Text & " " & "Rize"
        .Text = .Text & " " & "Konya"
        .Text = .Text & " " & "Zonguldak"
        .Text = .Text & " " & "Ankara"
        .Text = .Text & " " & "İstanbul"
        .Text = .Text & " " & "Manisa"
        .Text = .Text & " " & "Hakkari"
        .Text = .Text & " " & "Bursa"
        .Text = .Text & " " & "Trabzon"
        .Text = .Text & " " & "Erzurum"
        .Text = .Text & " " & "Antalya"
        .Text = .Text & " " & "Malatya"
        .Text = .Text & " " & "Denizli"
        .Text = .Text & " " & "Sivas"
        .Text = .Text & " " & "Edirne"
        .Text = .Text & " " & "Kahramanmaraş"
        .Text = .Text & " " & "Balıkesir"
        .Text = .Text & " " & "Muş"
        .Text = .Text & " " & "Yozgat"
        .Text = .Text & " " & "Muğla"
        .Text = .Text & " " & "Rize"
        .Text = .Text & " " & "Konya"
        .Text = .Text & " " & "Zonguldak"
        .Text = .Text & " " & "Ankara"
        .Text = .Text & " " & "İstanbul"
        .Text = .Text & " " & "Manisa"
        .Text = .Text & " " & "Hakkari"
        .Text = .Text & " " & "Bursa"
        .Text = .Text & " " & "Trabzon"
        .Text = .Text & " " & "Erzurum"
        .Text = .Text & " " & "Antalya"
        .Text = .Text & " " & "Malatya"
        .Text = .Text & " " & "Denizli"
        .Text = .Text & " " & "Sivas"
        .Text = .Text & " " & "Edirne"
        .Text = .Text & " " & "Kahramanmaraş"
        .Text = .Text & " " & "Balıkesir"
        .Text = .Text & " " & "Muş"
        .Text = .Text & " " & "Yozgat"
        .Text = .Text & " " & "Muğla"
        .Text = .Text & " " & "Rize"
        .Text = .Text & " " & "Konya"
        .Text = .Text & " " & "Zonguldak"
        .Text = .Text & " " & "Ankara"
        .Text = .Text & " " & "İstanbul"
        .Text = .Text & " " & "Manisa"
        .Text = .Text & " " & "Hakkari"
        .Text = .Text & " " & "Bursa"
        .Text = .Text & " " & "Trabzon"
        .Text = .Text & " " & "Erzurum"
        .Text = .Text & " " & "Antalya"
        .Text = .Text & " " & "Malatya"
        .Text = .Text & " " & "Denizli"
        .Text = .Text & " " & "Sivas"
        .Text = .Text & " " & "Edirne"
        .Text = .Text & " " & "Kahramanmaraş"
        .Text = .Text & " " & "Balıkesir"
        .Text = .Text & " " & "Muş"
        .Text = .Text & " " & "Yozgat"
        .Text = .Text & " " & "Muğla"
        .Text = .Text & " " & "Rize"
        .Text = .Text & " " & "Konya"
        .Text = .Text & " " & "Zonguldak"
        .Text = .Text & " " & "Ankara"
        .Text = .Text & " " & "İstanbul"
        .Text = .Text & " " & "Manisa"
        .Text = .Text & " " & "Hakkari"
        .Text = .Text & " " & "Bursa"
        .Text = .Text & " " & "Trabzon"
        .Text = .Text & " " & "Erzurum"
        .Text = .Text & " " & "Antalya"
        .Text = .Text & " " & "Malatya"
        .Text = .Text & " " & "Denizli"
        .Text = .Text & " " & "Sivas"
        .Text = .Text & " " & "Edirne"
        .Text = .Text & " " & "Kahramanmaraş"
        .Text = .Text & " " & "Balıkesir"
        .Text = .Text & " " & "Muş"
        .Text = .Text & " " & "Yozgat"
        .Text = .Text & " " & "Muğla"
        .Text = .Text & " " & "Rize"
        .Text = .Text & " " & "Konya"
        .Text = .Text & " " & "Zonguldak"
        .Text = .Text & " " & "Ankara"
        .Text = .Text & " " & "İstanbul"
        .Text = .Text & " " & "Manisa"
        .Text = .Text & " " & "Hakkari"
        .Text = .Text & " " & "Bursa"
        .Text = .Text & " " & "Trabzon"
        .Text = .Text & " " & "Erzurum"
        .Text = .Text & " " & "Antalya"
        .Text = .Text & " " & "Malatya"
        .Text = .Text & " " & "Denizli"
        .Text = .Text & " " & "Sivas"
        .Text = .Text & " " & "Edirne"
        .Text = .Text & " " & "Kahramanmaraş"
        .Text = .Text & " " & "Balıkesir"
        .Text = .Text & " " & "Muş"
        .Text = .Text & " " & "Yozgat"
        .Text = .Text & " " & "Muğla"
        .Text = .Text & " " & "Rize"
        .Text = .Text & " " & "Konya"
        .Text = .Text & " " & "Zonguldak"
        .SetFocus
    End With
End Sub


10 Ekim 2004 Pazar

TextBox SendKeys


'UserForm1
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®]TextBox SendKeys..."
End Sub
Private Sub TextBox1_Change()
On Error Resume Next
If Not (IsNumeric(TextBox1)) Then SendKeys "{bs}"
End Sub
Private Sub TextBox2_Change()
On Error Resume Next
If Right(TextBox2, 1) Like "[0-9]" Then SendKeys "{bs}"
End Sub

1 Ekim 2004 Cuma

TextBox String Convert



'UserForm1

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®]TextBox String Convert..."
TextBox1.Value = "textBox string convert": Label1.Caption = " vbFormUnicode"
TextBox2.Value = "textBox string convert": Label2.Caption = " vbHiragana"
TextBox3.Value = "textBox string convert": Label3.Caption = " vbKatakana"
TextBox4.Value = "textBox string convert": Label4.Caption = " vbLowerCase"
TextBox5.Value = "textBox string convert": Label5.Caption = " vbNarrow"
TextBox6.Value = "textBox string convert": Label6.Caption = " vbProperCase"
TextBox7.Value = "textBox string convert": Label7.Caption = " vbUnicode"
TextBox8.Value = "textBox string convert": Label8.Caption = " vbUpperCase"
TextBox9.Value = "textBox string convert": Label9.Caption = " vbWide"
End Sub
Private Sub TextBox1_Change()
On Error Resume Next
TextBox1.Value = VBA.StrConv(TextBox1.Value, vbFromUnicode)
End Sub
Private Sub TextBox2_Change()
On Error Resume Next
TextBox2.Value = VBA.StrConv(TextBox2.Value, vbHiragana)
End Sub
Private Sub TextBox3_Change()
On Error Resume Next
TextBox3.Value = VBA.StrConv(TextBox3.Value, vbKatakana)
End Sub
Private Sub TextBox4_Change()
On Error Resume Next
TextBox4.Value = VBA.StrConv(TextBox4.Value, vbLowerCase)
End Sub
Private Sub TextBox5_Change()
On Error Resume Next
TextBox5.Value = VBA.StrConv(TextBox5.Value, vbNarrow)
End Sub
Private Sub TextBox6_Change()
On Error Resume Next
TextBox6.Value = VBA.StrConv(TextBox6.Value, vbProperCase)
End Sub
Private Sub TextBox7_Change()
On Error Resume Next
TextBox7.Value = VBA.StrConv(TextBox7.Value, vbUnicode)
End Sub
Private Sub TextBox8_Change()
On Error Resume Next
TextBox8.Value = VBA.StrConv(TextBox8.Value, vbUpperCase)
End Sub
Private Sub TextBox9_Change()
On Error Resume Next
TextBox9.Value = VBA.StrConv(TextBox9.Value, vbWide)
End Sub

20 Eylül 2004 Pazartesi

Date Text Format




'UserForm1

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Date Text Format..."
With TextBox1
.MaxLength = 10
.EnterFieldBehavior = fmEnterFieldBehaviorRecallSelection
.Text = "##.##.####"
.SelStart = 0
.SelLength = 1
End With
End Sub
Private Sub TextBox1_Change()
On Error Resume Next
With TextBox1
.SelLength = 1
If .SelText = "." Then
.SelStart = .SelStart + 1
.SelLength = 1
End If
End With
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error GoTo Hata:
With TextBox1
If KeyCode = vbKeyLeft Or KeyCode = vbKeyBack Then
KeyCode = vbKeySelect
.SelStart = .SelStart - 1
.SelLength = 1
ElseIf KeyCode = vbKeyRight Then
KeyCode = vbKeySelect
.SelStart = .SelStart + 1
.SelLength = 1
ElseIf KeyCode = vbKeyDelete Then
KeyCode = vbKeySelect
If .SelText = "." Then
.SelText = "."
Else
.SelText = "#"
End If
.SelStart = .SelStart - 1
.SelLength = 1
ElseIf KeyCode = vbKeyHome Then
KeyCode = vbKeySelect
.SelStart = 0
.SelLength = 1
ElseIf KeyCode = vbKeyEnd Then
KeyCode = vbKeySelect
.SelStart = Len(TextBox1) - 1
.SelLength = 1
End If
End With
Exit Sub
Hata:
KeyCode = vbKeySelect
TextBox1.SelStart = 0
TextBox1.SelLength = 1
End Sub

10 Eylül 2004 Cuma

Date Difference



'UserForm1

'A) Additional Tools

'A1) Label1, Label2, Label3
'A2) TextBox1, TextBox2, TextBox3
'A3) CommandButton1

Option Explicit
Dim t1, t2, t3
Dim YF As Integer 'Yıl Farkı [Year Difference]
Dim AF As Integer 'Ay Farkı [Month Difference]
Dim GF As Integer 'Gün Farkı [Day Difference]
Dim Tarih As Date
Private Sub UserForm_Initialize()
    On Error Resume Next
    Me.Caption = "[PBİD®] Date Difference..."
    Call Ekran_Kur

End Sub
Private Sub CommandButton1_Click()

    On Error Resume Next
    t1 = TextBox1.Value 'İlk Tarihi [Start Date]
    t2 = TextBox2.Value 'Son Tarihi [Finish date]
    t3 = Tarihfarki(VBA.CDate(t1), VBA.CDate(t2))
    TextBox3.Value = t3 'Tarihi Farkı [Date Difference]

End Sub
Private Function Tarihfarki(D1 As Date, D2 As Date) As Variant

    On Error Resume Next
    If D1 > D2 Then
        Tarih = D1
        D1 = D2
        D2 = Tarih
    End If
    YF = VBA.Year(D2) - VBA.Year(D1)
    If VBA.DateSerial(VBA.Year(D2), VBA.Month(D1), VBA.Day(D1)) > D2 Then
        YF = YF - 1
    End If
    If VBA.Month(D2) > VBA.Month(D1) Then
        If VBA.Day(D2) > VBA.Day(D1) Or VBA.Day(D2) = VBA.Day(D1) Then
            AF = VBA.Month(D2) - VBA.Month(D1)
        Else
            AF = VBA.Month(D2) - VBA.Month(D1) - 1
        End If
    Else
        If VBA.Day(D2) > VBA.Day(D1) Or VBA.Day(D2) = VBA.Day(D1) Then AF = VBA.Month(D2) - VBA.Month(D1) + 12
        If AF = 12 Then
            AF = 0
        Else
            AF = VBA.Month(D2) - VBA.Month(D1) + 11
        End If
    End If
    If VBA.Day(D2) > VBA.Day(D1) Or VBA.Day(D2) = VBA.Day(D1) Then
        GF = VBA.Day(D2) - VBA.Day(D1)
    Else
        GF = VBA.Day(VBA.DateSerial(VBA.Year(D1), VBA.Month(D1) + 1, 1) - 1) - VBA.Day(D1) + VBA.Day(D2)
    End If
    Tarihfarki = YF & " Yıl " & AF & " Ay " & GF & " Gün"
    If YF = 0 Then
        Tarihfarki = AF & " Ay " & GF & " Gün"
    End If
    If AF = 0 Then
        Tarihfarki = YF & " Yıl " & GF & " Gün"
    End If
    If GF = 0 Then
        Tarihfarki = YF & " Yıl " & AF & " Ay "
    End If

End Function
Sub Ekran_Kur()

    On Error Resume Next
    With Me
        .Height = 180
        .Width = 240
        .BackColor = VBA.RGB(242, 242, 242)
        With Label1
            .Left = 6
            .Top = 6
            .Height = 18
            .Width = 114
            .Caption = " İlk Tarih [Start Date]"
            .SpecialEffect = fmSpecialEffectEtched
        End With
        With TextBox1
            .Left = 126
            .Top = 6
            .Height = 18
            .Width = 102
            .SpecialEffect = fmSpecialEffectEtched
            .ForeColor = vbBlue
        End With
        With Label2
            .Left = 6
            .Top = 30
            .Height = 18
            .Width = 114
            .Caption = " Son Tarih [Finish Date]"
            .SpecialEffect = fmSpecialEffectEtched
        End With
        With TextBox2
            .Left = 126
            .Top = 30
            .Height = 18
            .Width = 102
            .SpecialEffect = fmSpecialEffectEtched
            .ForeColor = vbBlue
            .Text = VBA.Format(VBA.Now(), "dd.mm.yyyy")
        End With
        With Label3
            .Left = 6
            .Top = 54
            .Height = 18
            .Width = 114
            .Caption = " Tarih Farkı [Date Difference]"
            .SpecialEffect = fmSpecialEffectEtched
        End With
        With TextBox3
            .Left = 126
            .Top = 54
            .Height = 18
            .Width = 102
            .SpecialEffect = fmSpecialEffectEtched
            .ForeColor = vbBlue
        End With
        With CommandButton1
            .Left = 6
            .Top = 78
            .Height = 24
            .Width = 222
            .Caption = "Hesapla"
        End With
    End With
End Sub

1 Eylül 2004 Çarşamba

Data Sort on Sheet





'UserForm1

'A) Windows XP® Office 2003® Normal Referance List

'Name: VBA, Description: Visual Basic For Applications, Full Path: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL'Name: Excel, Description: Microsoft Excel 11.0 Object Library, Full Path: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE'Name: stdole, Description: OLE Automation, Full Path: C:\WINDOWS\system32\stdole2.tlb
'Name: Office, Description: Microsoft Office 11.0 Object Library, Full Path: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL'Name: MSForms, Description: Microsoft Forms 2.0 Object Library, Full Path: C:\WINDOWS\system32\FM20.DLL
'B) UserForm1'e Eklenen Araçlar (Add Tools)
'ListBox1, CommandButton1, CommandButton2, Label1
Option Explicit
Dim i, j As Single
Dim Hücre As Range
Dim Bellek(1 To 20, 1 To 10)
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] Data Sort on Sheet"
Call EkranDüzenle
Call VeriDüzenle
End Sub
Private Sub CommandButton1_Click()
'Number Sort

On Error GoTo 0
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Call Sırala
End Sub
Private Sub CommandButton2_Click()
'Name Sort

On Error GoTo 0
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Call Sırala
End Sub
Private Sub Sırala()
'Sort

On Error GoTo 0
i = 1: j = 1
For Each Hücre In Sheets(1).Range("A1:B81")
If Hücre.Column = 1 Then
If i > 0 And i <= 20 Then Bellek(j, 1) = Hücre.Value
If i > 20 And i <= 40 Then Bellek(j, 3) = Hücre.Value
If i > 40 And i <= 60 Then Bellek(j, 5) = Hücre.Value
If i > 60 And i <= 80 Then Bellek(j, 7) = Hücre.Value
If i > 80 And i <= 100 Then Bellek(j, 9) = Hücre.Value
Else
If i > 0 And i <= 20 Then Bellek(j, 2) = Hücre.Value
If i > 20 And i <= 40 Then Bellek(j, 4) = Hücre.Value
If i > 40 And i <= 60 Then Bellek(j, 6) = Hücre.Value
If i > 60 And i <= 80 Then Bellek(j, 8) = Hücre.Value
If i > 80 And i <= 100 Then Bellek(j, 10) = Hücre.Value
i = i + 1
j = j + 1
If (j > 20) Then j = 1
End If
Next Hücre
ListBox1.List() = Bellek
End Sub
Private Sub EkranDüzenle()
'Form Creation

On Error Resume Next
With Me
.Height = 258
.Width = 444
.BackColor = vbWhite
With ListBox1
.Left = 6
.Top = 6
.Height = 204
.Width = 428
.TextAlign = fmTextAlignLeft
.SpecialEffect = fmSpecialEffectEtched
.BackColor = vbWhite
.ColumnCount = 10
.ColumnWidths = "18 pt;66 pt;18 pt;66 pt;18 pt;66 pt;18 pt;66 pt;18 pt;66 pt"
.Clear
.BackColor = &H80000013
.ForeColor = vbBlue
End With
With CommandButton1
.Left = 6
.Top = ListBox1.Top + ListBox1.Height + 6
.Width = 72
.Height = 18
.Caption = "Number Sort"
End With
With CommandButton2
.Left = CommandButton1.Left + CommandButton1.Width + 6
.Top = ListBox1.Top + ListBox1.Height + 6
.Width = 72
.Height = 18
.Caption = "Name Sort"
End With
With Label1
.Top = ListBox1.Top + ListBox1.Height + 6
.Left = CommandButton2.Left + CommandButton2.Width + 6
.Height = 12
.Width = 270
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleNone
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.ForeColor = vbBlue
.Caption = "Mustafa ULUSARAÇ, 01ulusarac@superonline.com"
End With
End With
End Sub
Private Sub VeriDüzenle()
'Data Creation

On Error Resume Next
Sheets(1).Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Cells(1, 1) = 1: Cells(1, 2) = "Adana"
Cells(2, 1) = 2: Cells(2, 2) = "Adıyaman"
Cells(3, 1) = 3: Cells(3, 2) = "Afyon"
Cells(4, 1) = 4: Cells(4, 2) = "Ağrı"
Cells(5, 1) = 5: Cells(5, 2) = "Amasya"
Cells(6, 1) = 6: Cells(6, 2) = "Ankara"
Cells(7, 1) = 7: Cells(7, 2) = "Antalya"
Cells(8, 1) = 8: Cells(8, 2) = "Artvin"
Cells(9, 1) = 9: Cells(9, 2) = "Aydın"
Cells(10, 1) = 10: Cells(10, 2) = "Balıkesir"
Cells(11, 1) = 11: Cells(11, 2) = "Bilecik"
Cells(12, 1) = 12: Cells(12, 2) = "Bingöl"
Cells(13, 1) = 13: Cells(13, 2) = "Bitlis"
Cells(14, 1) = 14: Cells(14, 2) = "Bolu"
Cells(15, 1) = 15: Cells(15, 2) = "Burdur"
Cells(16, 1) = 16: Cells(16, 2) = "Bursa"
Cells(17, 1) = 17: Cells(17, 2) = "Çanakkale"
Cells(18, 1) = 18: Cells(18, 2) = "Çankırı"
Cells(19, 1) = 19: Cells(19, 2) = "Çorum"
Cells(20, 1) = 20: Cells(20, 2) = "Denizli"
Cells(21, 1) = 21: Cells(21, 2) = "Diyarbakır"
Cells(22, 1) = 22: Cells(22, 2) = "Edirne"
Cells(23, 1) = 23: Cells(23, 2) = "Elazığ"
Cells(24, 1) = 24: Cells(24, 2) = "Erzincan"
Cells(25, 1) = 25: Cells(25, 2) = "Erzurum"
Cells(26, 1) = 26: Cells(26, 2) = "Eskişehir"
Cells(27, 1) = 27: Cells(27, 2) = "Gaziantep"
Cells(28, 1) = 28: Cells(28, 2) = "Giresun"
Cells(29, 1) = 29: Cells(29, 2) = "Gümüşhane"
Cells(30, 1) = 30: Cells(30, 2) = "Hakkari"
Cells(31, 1) = 31: Cells(31, 2) = "Hatay"
Cells(32, 1) = 32: Cells(32, 2) = "Isparta"
Cells(33, 1) = 33: Cells(33, 2) = "İçel"
Cells(34, 1) = 34: Cells(34, 2) = "İstanbul"
Cells(35, 1) = 35: Cells(35, 2) = "İzmir"
Cells(36, 1) = 36: Cells(36, 2) = "Kars"
Cells(37, 1) = 37: Cells(37, 2) = "Kastamonu"
Cells(38, 1) = 38: Cells(38, 2) = "Kayseri"
Cells(39, 1) = 39: Cells(39, 2) = "Kırklareli"
Cells(40, 1) = 40: Cells(40, 2) = "Kırşehir"
Cells(41, 1) = 41: Cells(41, 2) = "Kocaeli"
Cells(42, 1) = 42: Cells(42, 2) = "Konya"
Cells(43, 1) = 43: Cells(43, 2) = "Kütahya"
Cells(44, 1) = 44: Cells(44, 2) = "Malatya"
Cells(45, 1) = 45: Cells(45, 2) = "Manisa"
Cells(46, 1) = 46: Cells(46, 2) = "Kahramanmaraş"
Cells(47, 1) = 47: Cells(47, 2) = "Mardin"
Cells(48, 1) = 48: Cells(48, 2) = "Muğla"
Cells(49, 1) = 49: Cells(49, 2) = "Muş"
Cells(50, 1) = 50: Cells(50, 2) = "Nevşehir"
Cells(51, 1) = 51: Cells(51, 2) = "Niğde"
Cells(52, 1) = 52: Cells(52, 2) = "Ordu"
Cells(53, 1) = 53: Cells(53, 2) = "Rize"
Cells(54, 1) = 54: Cells(54, 2) = "Sakarya"
Cells(55, 1) = 55: Cells(55, 2) = "Samsun"
Cells(56, 1) = 56: Cells(56, 2) = "Siirt"
Cells(57, 1) = 57: Cells(57, 2) = "Sinop"
Cells(58, 1) = 58: Cells(58, 2) = "Sivas"
Cells(59, 1) = 59: Cells(59, 2) = "Tekirdağ"
Cells(60, 1) = 60: Cells(60, 2) = "Tokat"
Cells(61, 1) = 61: Cells(61, 2) = "Trabzon"
Cells(62, 1) = 62: Cells(62, 2) = "Tunceli"
Cells(63, 1) = 63: Cells(63, 2) = "Şanlıurfa"
Cells(64, 1) = 64: Cells(64, 2) = "Uşak"
Cells(65, 1) = 65: Cells(65, 2) = "Van"
Cells(66, 1) = 66: Cells(66, 2) = "Yozgat"
Cells(67, 1) = 67: Cells(67, 2) = "Zonguldak"
Cells(68, 1) = 68: Cells(68, 2) = "Aksaray"
Cells(69, 1) = 69: Cells(69, 2) = "Bayburt"
Cells(70, 1) = 70: Cells(70, 2) = "Karaman"
Cells(71, 1) = 71: Cells(71, 2) = "Kırıkkale"
Cells(72, 1) = 72: Cells(72, 2) = "Batman"
Cells(73, 1) = 73: Cells(73, 2) = "Şırnak"
Cells(74, 1) = 74: Cells(74, 2) = "Bartın"
Cells(75, 1) = 75: Cells(75, 2) = "Ardahan"
Cells(76, 1) = 76: Cells(76, 2) = "Iğdır"
Cells(77, 1) = 77: Cells(77, 2) = "Yalova"
Cells(78, 1) = 78: Cells(78, 2) = "Karabük"
Cells(79, 1) = 79: Cells(79, 2) = "Kilis"
Cells(80, 1) = 80: Cells(80, 2) = "Osmaniye"
Cells(81, 1) = 81: Cells(81, 2) = "Düzce"
End Sub 

20 Ağustos 2004 Cuma

Print Preview

'Module1
Sub Print_Preview()
On Error GoTo 0
ActiveSheet.PrintPreview False
ActiveWindow.View = xlNormalView
End Sub

10 Ağustos 2004 Salı

SpecialCells Method




'Module1

'Alan.SpecialCells(Type, Value).Command
'Type
'xlCellTypeAllFormatConditions' [Biçim]
'xlCellTypeAllValidation' [Doğrulama Kriteri]
'xlCellTypeBlanks' [Boş Hücreler]
'xlCellTypeComments' [Hücre Açıklma Notları]
'xlCellTypeConstants' [Hücrelere Ait Sabitler]
'xlCellTypeFormulas' [Hücrelere Ait Formüller]
'xlCellTypeLastCell' [Kullanılan Son Hücre Aralığı]
'xlCellTypeSameFormatConditions' [Benzer Formatta Olan Hücreler]
'xlCellTypeSameValidation' [Benzer Doğrulama Kriterindeki Hücreler]
'xlCellTypeVisible' [Tüm Görünür Hücreler]
'Value
'xlErrors
'xlLogical
'xlNumbers
'xlTextValues
Option Explicit
Dim Hücre As Range
Dim Rapor As String
SpecialCells Method

Sub SpecialCells_xlCellTypeAllValidation_Method()
On Error GoTo Hata
Rapor = Empty
ActiveSheet.Cells.SpecialCells(xlCellTypeSameFormatConditions).Select
For Each Hücre In Selection
Rapor = Rapor & vbCrLf & Hücre.Address
Next Hücre
MsgBox "xlCellTypeAllValidation Özelliklerdeki Hücre Listesi" & vbCrLf & vbCrLf & Rapor & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", vbInformation, "[PBİD®]SpecialCells Method"
Exit Sub
Hata:
MsgBox "Aranan Özelliklerde Hiçbir Hücre Bulunamadı" & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", vbInformation, "[PBİD®]SpecialCells Method"
End Sub

1 Ağustos 2004 Pazar

SaveAs Enabled/Disabled


'ThisWorkbook Module

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo 0
If SaveAsUI Then
Cancel = True 'False farklı kaydede izin verir.
End If
End Sub

20 Temmuz 2004 Salı

CommandBarControls Management




'Module1

Dim CBC As Office.CommandBarControl
Dim Rapor As String

Sub MenüKomutlarınıKapat()
On Error GoTo 0
Rapor = Empty
For Each CBC In Application.CommandBars.FindControls(Id:=847)
CBC.Enabled = False
Rapor = Rapor & VBA.Chr(13) & CBC.Caption
Next CBC
For Each CBC In Application.CommandBars.FindControls(Id:=889)
CBC.Enabled = False
Rapor = Rapor & VBA.Chr(13) & CBC.Caption
Next CBC
MsgBox "Kullanım DIŞINA alınan [CBC] Menü Komutları" & VBA.Chr(13) & Rapor & vbCrLf & VBA.Chr(13) & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", vbInformation, "[PBİD®] CommandBarControl Enabled/Disabled..."
End Sub
Sub MenüKomutlarınıAç()
On Error GoTo 0
Rapor = Empty
For Each CBC In Application.CommandBars.FindControls(Id:=847)
CBC.Enabled = True
Rapor = Rapor & VBA.Chr(13) & CBC.Caption
Next CBC
For Each CBC In Application.CommandBars.FindControls(Id:=889)
CBC.Enabled = True
Rapor = Rapor & VBA.Chr(13) & CBC.Caption
Next CBC
MsgBox "Kullanım İÇİNE alınan [CBC] Menü Komutları" & VBA.Chr(13) & Rapor & vbCrLf & VBA.Chr(13) & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", vbInformation, "[PBİD®] CommandBarControl Enabled/Disabled..."
End Sub

10 Temmuz 2004 Cumartesi

Enabled / Disable Cut And Paste


'Module1

Option Explicit
Dim CB As CommandBar
Dim CBC As CommandBarControl

Sub DisableCutAndPaste()
On Error GoTo 0
EnableControl 21, False 'Cut
EnableControl 19, False 'Copy
EnableControl 22, False 'Paste
EnableControl 755, False 'PasteSpecial
Application.OnKey "^c", ""
Application.OnKey "^v", ""
Application.OnKey "+{DEL}", ""
Application.OnKey "+{INSERT}", ""
Application.CellDragAndDrop = False
End Sub
Sub EnableCutAndPaste()
On Error GoTo 0
EnableControl 21, True 'Cut
EnableControl 19, True 'Copy
EnableControl 22, True 'Paste
EnableControl 755, True 'PasteSpecial
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
End Sub
Sub EnableControl(Id As Integer, Enabled As Boolean)
On Error Resume Next
For Each CB In Application.CommandBars
Set CBC = CB.FindControl(Id:=Id, Recursive:=True)
If Not CBC Is Nothing Then CBC.Enabled = Enabled
Next
End Sub

1 Temmuz 2004 Perşembe

Multi Sheet Print



'Module1

Option Explicit
Dim AktifOlan As Object, Sayfa, Sayfalar, SonResim As Object
Dim Yazdırılan As Worksheet
Dim Resimler As Integer

Sub Çoklu_Sayfa_Yazdırma()
On Error GoTo 0
Set Sayfalar = ActiveWindow.SelectedSheets
If Sayfalar.Count = 1 Then
Selection.PrintOut preview:=True
Exit Sub
End If
Set AktifOlan = ActiveSheet
Application.ScreenUpdating = False
AktifOlan.Select
Set Yazdırılan = Worksheets.Add
For Each Sayfa In Sayfalar
If TypeName(Sayfa) = "Worksheet" Then
Resimler = Resimler + 1
Sayfa.Activate
Selection.CopyPicture
Yazdırılan.Cells(Resimler * 3 - 2, 1).Value = Sayfa.Name
Yazdırılan.Paste Yazdırılan.Cells(Resimler * 3 - 1, 1)
Yazdırılan.Rows(Resimler * 3 - 1).RowHeight = Yazdırılan.Pictures(Resimler).Height
End If
Next Sayfa
Yazdırılan.PrintOut preview:=True
Application.DisplayAlerts = False
Yazdırılan.Delete
Application.DisplayAlerts = True
Sayfalar.Select
AktifOlan.Activate
Application.ScreenUpdating = True
End Sub

20 Haziran 2004 Pazar

Interior Descriptions


'Module1

Sub KırmızıSatırıSil()
On Error Resume Next
Dim Hücre As Range, i As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set Hücre = Intersect(Range("A:A"), ActiveSheet.UsedRange)
For i = Hücre.Count To 1 Step -1
If Hücre.Item(i).Interior.ColorIndex = 3 Then
Hücre.Item(i).EntireRow.Delete
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub BoşDoluHücreleriRenklendir()
On Error Resume Next
Dim Hücre As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Hücre In Intersect(Selection, ActiveCell.EntireColumn, ActiveSheet.UsedRange)
Select Case Hücre.Value
Case (Is >= 50)
Hücre.EntireRow.Interior.ColorIndex = 20
Case (Is >= 40)
Hücre.EntireRow.Interior.ColorIndex = 37
Case (Is >= 20)
Hücre.EntireRow.Interior.ColorIndex = 38
Case (Is >= 0)
Hücre.EntireRow.Interior.ColorIndex = 36
Case Else
Hücre.EntireRow.Interior.ColorIndex = 44
End Select
Next Hücre
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub 

'Sheets("Sayfa1") Module

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Intersect(Target, Range("A1:B10")) Is Nothing Then Exit Sub
If (Target.Value > 10) Then
Target.Interior.ColorIndex = 6
Else
Target.Interior.ColorIndex = xlNone
End If
End Sub

Blog Arşivi

Gadget

Bu içerik henüz şifreli bağlantı üzerinden kullanılamıyor.

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
Anadolu Üniversitesi Açık Öğretim Fakültesi