Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Mayıs 2009 Çarşamba

MS Office® Speech [1]


'UserForm1

'References Add; Microsoft Speech Object Library
'Path; C:\Program Files\Common Files\Microsoft Shared\Speech\Sapi.dll
'AddTools on UserForm1; Label1, TextBox1, Image1, Label2, CommandButton1

Option Explicit
Private WithEvents Seslendirme As SpVoice
Private Sub UserForm_Initialize()
    On Error Resume Next
    ThisWorkbook.VBProject.References.AddFromGuid "{C866CA3A-32F7-11D2-9602-00C04F8EE628}", 5, 4 'Add Sapi.dll
    Me.Caption = "[PBİD®] MS Office® Speech [1]"
    With TextBox1
        .AutoTab = True
        .Enabled = True
        .EnterKeyBehavior = True
        .Locked = False
        .MultiLine = True
        .ScrollBars = fmScrollBarsVertical
        .Text = "Mustafa ULUSARAÇ" & vbCrLf & "
01ulusarac@superonline.com" & vbCrLf & "[PBİD®] Speech..."
    End With
End Sub
Private Sub CommandButton1_Click()

    On Error Resume Next
    Set Seslendirme = New SpVoice
    Seslendirme.Speak TextBox1.Text
End Sub
'Sub References_List()
'    On Error Resume Next
'    Dim Eleman, No
'    No = 1
'    For Each Eleman In ThisWorkbook.VBProject.References
'        Sheets(1).Cells(No, 1) = No & ") Name: "
'        Sheets(1).Cells(No, 2) = Eleman.Name
'        Sheets(1).Cells(No, 3) = ", Description: "
'        Sheets(1).Cells(No, 4) = Eleman.Description
'        Sheets(1).Cells(No, 5) = ", FullPath: "
'        Sheets(1).Cells(No, 6) = Eleman.FullPath
'        Sheets(1).Cells(No, 7) = ", GUID: "
'        Sheets(1).Cells(No, 8) = Eleman.GUID
'        Sheets(1).Cells(No, 9) = ", Minor: "
'        Sheets(1).Cells(No, 10) = Eleman.minor
'        Sheets(1).Cells(No, 11) = ", Major: "
'        Sheets(1).Cells(No, 12) = Eleman.major
'        No = No + 1
'    Next Eleman
'End Sub

10 Mayıs 2009 Pazar

Insert Row Upstairs

'Module1
Option Explicit
Dim Hücre As Range

Sub ÜstüneSatırEkle() '[InserUpstairs]
     On Error Resume Next
     Set Hücre = ActiveCell
     Hücre.Rows("1:4").EntireRow.Insert Shift:=xlDown
     Hücre.Offset(-4, 0).Value = Date
     Hücre.Offset(-3, 0).Value = Date
     Hücre.Offset(-2, 0).Value = Date
     Hücre.Offset(-1, 0).Value = Date

End Sub

1 Mayıs 2009 Cuma

Uppercase / Lowercase Letters Arrangement



'Sheets(1) Code Page

Option Explicit
Dim i As Single
Dim X1, X2 As String, simge As String

Private Sub Worksheet_Change(ByVal Target As Range) '[Uppercase / Lowercase Letters Arrangement]
On Error Resume Next
If Target.Column = 2 And Not Target = Empty Then Target.Value = KS(Target.Value)
If Target.Column = 3 And Not Target = Empty Then Target.Value = BS(Target.Value)
If Target.Column = 4 And Not Target = Empty Then Target.Value = İS(Target.Value)
If Target.Column = 5 And Not Target = Empty Then Target.Value = SS(Target.Value)
End Sub
Function KS(simge) 'Küçük Simge= All lowercase
On Error Resume Next
KS = VBA.Replace(simge, "İ", "i")
KS = VBA.Replace(KS, "I", "ı")
KS = VBA.LCase(KS)
End Function
Function BS(simge) 'Büyük Simge= All uppercase
On Error Resume Next
BS = VBA.Replace(simge, "i", "İ")
BS = VBA.Replace(BS, "ı", "I")
BS = VBA.UCase(BS)
End Function
Function İS(simge) 'İlk Karakteri Büyük Simge= The first character uppercase
On Error Resume Next
X1 = Empty: X2 = Empty
İS = VBA.Replace(simge, "i", "İ")
İS = VBA.Replace(İS, "ı", "I")
For i = 1 To VBA.Len(İS)
X1 = VBA.Right(VBA.left(İS, i), 1)
If i = 1 And Not X1 = Empty Then
X2 = VBA.UCase(X1)
İS = VBA.left(İS, (i - 1)) & VBA.Replace(İS, X1, X2, i, 1, vbTextCompare)
Else
X2 = VBA.LCase(X1)
İS = VBA.left(İS, (i - 1)) & VBA.Replace(İS, X1, X2, i, 1, vbTextCompare)
End If
X2 = X1
Next i
End Function
Function SS(simge) 'Aralıklardan Sonrakiler Büyük Simge= The later of space Large Icons
On Error Resume Next
X1 = Empty: X2 = Empty
SS = VBA.Replace(simge, "i", "İ")
SS = VBA.Replace(SS, "ı", "I")
For i = 1 To VBA.Len(SS)
X1 = VBA.Right(VBA.left(SS, i), 1)
If i = 1 Or (Not X1 = Empty And X2 = " ") Then
X2 = VBA.UCase(X1)
SS = VBA.left(SS, (i - 1)) & VBA.Replace(SS, X1, X2, i, 1, vbTextCompare)
Else
X2 = VBA.LCase(X1)
SS = VBA.left(SS, (i - 1)) & VBA.Replace(SS, X1, X2, i, 1, vbTextCompare)
End If
X2 = X1
Next i
End Function

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