• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

büyük küçük harf uygulaması

  • Konbuyu başlatan Konbuyu başlatan azize
  • Başlangıç tarihi Başlangıç tarihi
Katılım
25 Aralık 2006
Mesajlar
205
Excel Vers. ve Dili
OFFİCE 2003 EXCELL 2003
merhaba ,
benim isteğim büyük küçük harf uygulaması ile eklentileri bir başlık altında toplayabilmek ve bu sayede daha pratik olacak ..Bilgisayarımda Case diye başlayan bir eklenti vardı format çektirince bilgisayara gitti . Şimdi o eklentiyi bulamıyorum bana yardımcı olursanız çok sevinirim saygılarımla ..
 

çok teşekkür ederim ama ben o zaman eklenti olarak eklemiyi yapabilmişim şimdi yapamıyorum .. ytl uygulaması gibi eklentileri ekledim ama bunu yapamadım acaba nerde hata yapıyorum bilmiyorum ..
1 adım
Araçlar - Makro - Visual Basic

diyorum sonra kodu yazıyorum kaydediyorum ve eklenti olarak kaydediyorum ama olmuyor acaba nerde hata yapıyorum .. saygılarımla ..
 
Araçlar-Eklentiler-Gözat deyin xla olarak çevirebildiğinize göre xla haline çevirdiğiniz bu dosyayı açılan bu AddIns penceresinin içerisine yapıştırın.
 
Araçlar-Eklentiler-Gözat deyin xla olarak çevirebildiğinize göre xla haline çevirdiğiniz bu dosyayı açılan bu AddIns penceresinin içerisine yapıştırın.


'*****************************************************************************
'* Excel' de hucrelerde yazılı metinlerin; *
'* - Tum harflerin buyuk harf yapilmasi *
'* - Kelimelerin ilk harflerinin buyuk harf yapilmasi *
'* - Tum harflarin kucuk harf yapilmasi *
'* - Cumle yazim duzeni yapilmasi *
'* *
'* Islevleri, sayfa uzerindeki sag tus menusune ilave edilmistir. *
'* Kodlar, Turkce karakterlerde problem cikartmaz. *
'* *
'* Burasi Excel Vadisi ... *
'* 21/09/2005 *
'* Haluk ® *
'* *
'* Revizyon -1 : 2 veya daha fazla kelimeden olusan metinlerin, *
'* sadece son kelimesinde harflerin, buyuk harfe *
'* cevrilmesi ile ilgili menu ilave edildi. *
'* *
'* *
'* Revizyon -2 : Menu, klavyeden Shift + F3 tusuna her basista degise_ *
'* cek sekilde ayarlandi. (MS Word programindaki gibi) *
'* *
'* 29/01/2006 *
'* Haluk ® *
'*****************************************************************************
' Raider ®
Public j As Integer
'
Sub Auto_Open()
Call SpecialCellMenu
Application.OnKey "+{F3}", "KeyBoardEntry"
End Sub
'
Sub SpecialCellMenu()
Dim cb As CommandBar
Set cb = Application.CommandBars("Cell")
'
Set MenuObject = cb.Controls.Add(Type:=msoControlPopup, Temporary:=True)
MenuObject.Caption = "Change Case...®"
MenuObject.BeginGroup = True
MenuObject.Tag = "MyTagR"
'
For MenuItem = 1 To 5
Set PopItem = MenuObject.Controls.Add(msoControlButton, 1, MenuItem, , True)
PopItem.FaceId = 7
With PopItem
Select Case MenuItem
Case 1
.Caption = "ABC DEF"
Case 2
.Caption = "Abc Def"
Case 3
.Caption = "abc def"
Case 4
.Caption = "Abc def"
Case 5
.Caption = "Abc Def GHI"
End Select
.OnAction = "CaseChange"
End With
Next
Set cb = Nothing
Set PopItem = Nothing
Set MenuObject = Nothing
End Sub
'
Sub Auto_Close()
Application.CommandBars("Cell").Reset
Application.OnKey "+{F3}"
End Sub
'
Sub CaseChange()
Dim lngType As Long, MyRng As Range
Set MyWd = CreateObject("Word.Application")
Set MyDoc = MyWd.Documents.Add
On Error Resume Next
x = CommandBars.ActionControl.Parameter
On Error GoTo 0
If j > 0 Then x = j
Select Case x
Case 1
lngType = 1
Case 2
lngType = 2
Case 3
lngType = 0
Case 4
lngType = 4
Case 5
For Each MyRng In Selection
If (Not MyRng = Empty) And (Not IsNumeric(MyRng)) Then
Temp = ""
z = ""
c = ""
MyWd.Selection.Text = MyRng.Text
MyWd.Selection.Range.Case = 2
Temp = MyWd.Selection.Text
MyRng = Temp
z = StrReverse(Temp)
x = InStr(1, z, " ")
If x > 0 Then
y = Mid(z, 1, InStr(1, z, " "))
For i = 1 To Len(y)
c = c & WorksheetFunction.Proper(Mid(y, i, 1))
Next
MyRng = Mid(MyRng, 1, Len(MyRng) - x) & StrReverse(c)
End If
End If
Next
GoTo SafeExit:
End Select

For Each MyRng In Selection
If (Not MyRng = Empty) And (Not IsNumeric(MyRng)) Then
MyWd.Selection.Text = MyRng.Text
MyWd.Selection.Range.Case = lngType
MyRng = MyWd.Selection.Text
End If
Next

SafeExit:
MyDoc.Close False
MyWd.Quit
Set MyDoc = Nothing
Set MyWd = Nothing
End Sub
'
Sub KeyBoardEntry()
j = j + 1
If j > 5 Then j = 1
Call CaseChange
End Sub


Syn Ali Bey
teşekkür ederim bana bu kod çok gerekiyor onun için çok uğraşıyorum yukardaki kodu yazdım Addins e ekledim hatta eklenti şekli olan görüntü de çıktı eklentiler arasındada var aktif hale de getirdim ama olmuyor sağ tuşa basınca görünmüyor . Acaba kodu mu yanlış yazıyorum saygılarımla
 
Araçlar-Eklentiler-Gözat deyin xla olarak çevirebildiğinize göre xla haline çevirdiğiniz bu dosyayı açılan bu AddIns penceresinin içerisine yapıştırın.


çok teşekkür ederim .. buldum zip dosyasını ( geç oldu ama :) ) gördüm onu eklenti olarak kaydettim .. İlginiz için çok ama çok teşekkür ederim sağolun saygılarımla ..
 
Geri
Üst