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

10 Şubat 2009 Salı

ActiveControl [ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)]


'UserForm1

Option Explicit
Dim i As Long
Dim sText As String


Private Sub UserForm_Initialize()
On Error Resume Next
With ComboBox1
.AddItem "Per"
.AddItem "Person"
.AddItem "Personal"
.AddItem "Personality"
End With
End Sub
Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
If KeyAscii = vbKeyReturn Then
SendKeys "{tab}"
KeyAscii = 0
Exit Sub
End If
With Me.ActiveControl
If (KeyAscii = vbKeyBack And .SelStart > 0) Then
sText = Left$(.Text, .SelStart - 1)
Else
sText = Left$(.Text, .SelStart) & Chr(KeyAscii)
End If
KeyAscii = 0
For i = 0 To .ListCount - 1
If UCase$(sText) = UCase$(Left$(.List(i), Len(sText))) Then
.ListIndex = i
.Text = .List(i)
.SelStart = Len(sText)
.SelLength = Len(.List(i)) - (Len(sText))
Exit For
End If
Next i
End With
End Sub

1 Şubat 2009 Pazar

Delete All The Code in The Project

'Module1

Option Explicit
Dim KodSayfası
Sub ProjedekiTümKodlarıSil() 'Delete All The Code in The Project

If MsgBox("Projedeki bütün kodları silinecek. İşleme devam etmek istiyor musunuz?" & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", vbYesNo, "[PBİD®] PROJE KODLARININ YOKEDİLMESİ") = vbNo Then Exit Sub
For Each KodSayfası In ThisWorkbook.VBProject.VBComponents

With KodSayfası.CodeModule
.DeleteLines 1, .CountOfLines
End With

Next KodSayfası

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