büyük- küçük harf çevirme makrosu

[2008model]

hocam merhaba. benim bir kodum var küçük-büyük harfe çevirme kodu ama bir türlü çalışmıyor.maus'u sağ tıkladığımda" küçük-büyük harfe çevirme" bölümü eklenmiş olarak görünüyor.tıklayınca makro yok yada makro güvenliği kapalı hata mesajı veriyor.acaba sorun nerde yardımcı olursanız memnun olurum.kolay gelsin iyi öçalışmalar.


kod:

Sub Autpen()
Call Buyuk_Kucuk_harf
End Sub

Sub Buyuk_Kucuk_harf()
Dim cb As CommandBar
Set cb = Application.CommandBars("Cell")

Set MenuObject = cb.Controls.Add(Type:=msoControlPopup, Temporary:=True)
MenuObject.Caption = "Büyük / Küçük Harf Degistir..."
MenuObject.BeginGroup = True
MenuObject.Tag = "MyTagR"

For MenuItem = 1 To 4
Set PopItem = MenuObject.Controls.Add(msoControlButton, 1, MenuItem, , True)
PopItem.FaceId = 7
With PopItem
Select Case MenuItem
Case 1
.Caption = "Tümü Büyük Harf"
Case 2
.Caption = "Yalnizca Ilk Harf Büyük"
Case 3
.Caption = "Tümü Küçük Harf"
Case 4
.Caption = "Normal Yazim Düzeni"
End Select
.OnAction = "Degistir"

End With
Next
Set cb = Nothing
Set PopItem = Nothing
Set MenuObject = Nothing

End Sub

 

[tahsinanarat]

Sn. Haluk Hocamın kodlarını deneyiniz.

'**************************************************************************
'* 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 ® *
'* *
'**************************************************************************
' Raider ®
Sub Autpen()
Call SpecialCellMenu
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 4
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"
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
End Sub
'
Sub CaseChange()
Dim lngType As Long, MyRng As Range
Set MyWd = CreateObject("Word.Application")
Set MyDoc = MyWd.Documents.Add
Select Case CommandBars.ActionControl.Parameter
Case 1
lngType = 1
Case 2
lngType = 2
Case 3
lngType = 0
Case 4
lngType = 4
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
MyDoc.Close False
MyWd.Quit
Set MyDoc = Nothing
Set MyWd = Nothing
End Sub

 

[2008model]

Hocam işimi gördü çok teşekkürler kolay gelsin.allah razı olsun sizden

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak aşağıdaki linki incelermisiniz.

Büyük-küçük harf uygulaması