Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Şubat 2009 Cuma

Spelling Pattern on Worksheet




'Microsoft Excel Objects(Sheets(1))

Option Explicit
Dim Uzunluk As Double, ÖnUzunluk As Double
Dim Döngü As Boolean
Dim Bak As Boolean
Dim Bulgu As Range
Dim Metin As Variant, Bar As Single, BarKod As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Döngü = False Then YazımDüzeni Target
End Sub
Private Sub YazımDüzeni(ByVal Kaynak As Range)
On Error Resume Next
If Kaynak.Value = Empty Then
Exit Sub
Else
Metin = Kaynak.Value
Bak = True
Uzunluk = VBA.Len(Metin)
ÖnUzunluk = Uzunluk
Durak1:
For Bar = 1 To Uzunluk
BarKod = VBA.Mid(Metin, Bar, 1)
Select Case BarKod
Case 0 To 9
Durak2:
If Bak Then
If BarKod = "0" Then BarKod = "Sıfır"
If BarKod = "1" Then BarKod = "Bir"
If BarKod = "2" Then BarKod = "İki"
If BarKod = "3" Then BarKod = "Üç"
If BarKod = "4" Then BarKod = "Dört"
If BarKod = "5" Then BarKod = "Beş"
If BarKod = "6" Then BarKod = "Altı"
If BarKod = "7" Then BarKod = "Yedi"
If BarKod = "8" Then BarKod = "Sekiz"
If BarKod = "9" Then BarKod = "Dokuz"
Else
Bak = True
GoTo Durak2
End If
Case "."
Bak = True
Case "?"
Bak = True
Case "a" To "z"
If Bak Then
BarKod = VBA.UCase(BarKod)
Bak = False
End If
Case "A" To "Z"
If Bak Then
Bak = False
Else
BarKod = VBA.LCase(BarKod)
End If
End Select
Metin = Application.WorksheetFunction.Replace(Metin, Bar, 1, BarKod)
ÖnUzunluk = VBA.Len(Metin)
If (ÖnUzunluk <> Uzunluk) Then
Bar = Bar + (ÖnUzunluk - Uzunluk)
Uzunluk = ÖnUzunluk
Bak = True
GoTo Durak1
End If
            Next Bar
                        Döngü = True
                        Kaynak.Value = Metin

End If
Döngü = False
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