Büyük harf yazdırma

muratgunay48 · Pazartesi saat 00:26'de

Arkadaşlar, sayın hocalarım, "sürekli büyük harf yazsın" seçili alanda yapabildim ama tüm çalışma kitabında yapamadım. Yardımcı olabilir misiniz?
Teşekkür ederim.
Saygılarımla.

mustafa1205 · Pazartesi saat 00:30'de

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False
For Each c In Target
If Not IsError(c.Value) Then
If VarType(c.Value) = vbString Then
c.Value = UCase(c.Value)
End If
End If
Next c
Application.EnableEvents = True
End Sub

Yukarıdaki kodu ThisWorkbook modülüne ekleyin. Tüm çalışma kitabı yazıları büyük olacaktır...

Korhan Ayhan · Pazartesi saat 08:47'de

Merhaba,

UCASE kullanımında i-İ-ı-I harfleri sorun yaratmaktadır. REPLACE ile desteklenmesi gerekir.

muhasebeciyiz · Pazartesi saat 09:02'de

Kod:

Option Explicit

Private Sub Workbook_Open()
    Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo CleanExit
    If Application.EnableEvents = False Then Exit Sub
    Application.EnableEvents = False

    Dim c As Range, txt As String
    For Each c In Target.Cells
        If Not c.HasFormula Then
            If VarType(c.Value2) = vbString Then
                txt = CStr(c.Value2)
                txt = Replace(txt, "i", "İ")
                txt = Replace(txt, "ı", "I")
                txt = UCase$(txt)
                c.Value = txt
            End If
        End If
    Next c

CleanExit:
    Application.EnableEvents = True
End Sub

Bu kodu ThisWorkbook içine koyduğun zaman tüm sayfalarda geçerli olacak.

Korhan Ayhan · Pazartesi saat 10:53'de

Bu işlemler için bir fonksiyon kullanırsanız daha sağlıklı sonuçlar alırsınız.

Boş bir modüle aşağıdaki kodu uygulayınız.

C++:

Option Explicit

Function Case_Change(My_Range As Range, Case_Type As Byte) As String
    Dim Rng As Range
   
    For Each Rng In My_Range
        If Not Rng.HasFormula Then
            If Not IsNumeric(Rng.Value) Then
                Select Case Case_Type
                    Case 1: Rng.Value = Evaluate("=Upper(""" & Rng.Value & """)")
                    Case 2: Rng.Value = Evaluate("=Lower(""" & Rng.Value & """)")
                    Case 3: Rng.Value = Evaluate("=Proper(""" & Rng.Value & """)")
                    Case Else: Rng.Value = Rng.Value
                End Select
            End If
        End If
    Next
End Function

Sonrasında bu fonksiyonu dilediğiniz yerden çağırarak kullanabilirsiniz.

Aşağıdaki kodu ThisWorkbook (BuÇalışmaKitabı) bölümüne uygulayınız. Kod bu halilye TÜM SAYFALARDA A:Z sütun aralığında çalışacaktır.

C++:

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Intersect(Target, Range("A:Z")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Case_Change Target, 1
    Application.EnableEvents = True
End Sub

Fonksiyon parametrelidir.

1 Büyük harfe çevirir.
2 Küçük harfe çevirir.
3 Yazım düzenine çevirir.

Daha farklı eklemeler yapılarak fonksiyon revize edilebilir.

muratgunay48 · Salı saat 00:22'de

mustafa1205' Alıntı:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False
For Each c In Target
If Not IsError(c.Value) Then
If VarType(c.Value) = vbString Then
c.Value = UCase(c.Value)
End If
End If
Next c
Application.EnableEvents = True
End Sub

Yukarıdaki kodu ThisWorkbook modülüne ekleyin. Tüm çalışma kitabı yazıları büyük olacaktır...

Çok teşekkür ederim hocam.

muratgunay48 · Salı saat 00:25'de

muhasebeciyiz' Alıntı:

Kod:

Option Explicit

Private Sub Workbook_Open()
    Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo CleanExit
    If Application.EnableEvents = False Then Exit Sub
    Application.EnableEvents = False

    Dim c As Range, txt As String
    For Each c In Target.Cells
        If Not c.HasFormula Then
            If VarType(c.Value2) = vbString Then
                txt = CStr(c.Value2)
                txt = Replace(txt, "i", "İ")
                txt = Replace(txt, "ı", "I")
                txt = UCase$(txt)
                c.Value = txt
            End If
        End If
    Next c

CleanExit:
    Application.EnableEvents = True
End Sub

Bu kodu ThisWorkbook içine koyduğun zaman tüm sayfalarda geçerli olacak.

Çok teşekkür ederim hocam. Emeğinize sağlık.
Hocam belli sayfada olması için Private Sub Workbook_Open() değiştirip sayfa kod bölümüne yapıştırmamız yeterli olacaktır, doğru mu?

muratgunay48 · Salı saat 00:29'de

Korhan Ayhan' Alıntı:
Bu işlemler için bir fonksiyon kullanırsanız daha sağlıklı sonuçlar alırsınız.

Boş bir modüle aşağıdaki kodu uygulayınız.

C++:

Option Explicit Function Case_Change(My_Range As Range, Case_Type As Byte) As String Dim Rng As Range For Each Rng In My_Range If Not Rng.HasFormula Then If Not IsNumeric(Rng.Value) Then Select Case Case_Type Case 1: Rng.Value = Evaluate("=Upper(""" & Rng.Value & """)") Case 2: Rng.Value = Evaluate("=Lower(""" & Rng.Value & """)") Case 3: Rng.Value = Evaluate("=Proper(""" & Rng.Value & """)") Case Else: Rng.Value = Rng.Value End Select End If End If Next End Function

Sonrasında bu fonksiyonu dilediğiniz yerden çağırarak kullanabilirsiniz.

Aşağıdaki kodu ThisWorkbook (BuÇalışmaKitabı) bölümüne uygulayınız. Kod bu halilye TÜM SAYFALARDA A:Z sütun aralığında çalışacaktır.

C++:

Option Explicit Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Intersect(Target, Range("A:Z")) Is Nothing Then Exit Sub Application.EnableEvents = False Case_Change Target, 1 Application.EnableEvents = True End Sub

Fonksiyon parametrelidir.

1 Büyük harfe çevirir.
2 Küçük harfe çevirir.
3 Yazım düzenine çevirir.

Daha farklı eklemeler yapılarak fonksiyon revize edilebilir.

Hocam emeğinize sağlık. Fonksiyon olarak hiç düşünmemiştim.
Hocam belli sayfada nasıl yapılabilir.
Ayrıca Range("A1:Z100") yaptığım zaman, seçili alan olur, doğru mu?

mustafa1205 · Salı saat 00:33'de

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' Sadece "deneme" sayfasında çalışsın
If Sh.Name <> "deneme" Then Exit Sub

' İlgili aralık dışında ise çık
If Intersect(Target, Sh.Range("A1:C500")) Is Nothing Then Exit Sub

Application.EnableEvents = False
Case_Change Target, 1
Application.EnableEvents = True
End Sub

Korhan Hocamın kodunda isteğinize göre küçük bir revize....
Örnek Dosya da ekliyorum. Deneyiniz...

muratgunay48 · Salı saat 01:20'de

mustafa1205' Alıntı:
Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' Sadece "deneme" sayfasında çalışsın
If Sh.Name <> "deneme" Then Exit Sub

' İlgili aralık dışında ise çık
If Intersect(Target, Sh.Range("A1:C500")) Is Nothing Then Exit Sub

Application.EnableEvents = False
Case_Change Target, 1
Application.EnableEvents = True
End Sub

Korhan Hocamın kodunda isteğinize göre küçük bir revize....
Örnek Dosya da ekliyorum. Deneyiniz...

Sağ olun hocam. Var olun.

Necdet · Salı saat 08:47'de

muratgunay48' Alıntı:
Arkadaşlar, sayın hocalarım, "sürekli büyük harf yazsın" seçili alanda yapabildim ama tüm çalışma kitabında yapamadım. Yardımcı olabilir misiniz?
Teşekkür ederim.
Saygılarımla.

EN küçük sorunlarda ChatGPT ye soruyorum, sağolsun hemen çözüyor.
Tüm kitapta büyük harf yazsın istiyorsanız Caps tuşunu açıp ya da kapatmak daha mantıklı.
ChatGPT amcamın yanıtını buraya ekliyorum. Kodu kendinize göre sadece Büyük harfe çevirebilirsiniz. Kodu dosyayı açtığında otomatik çalıştırabilirsiniz. Nasıl yapılacağını artık sormaıyın15 yıllık üyesiniz.

Kod:

#If VBA7 Then
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#Else
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#End If

Const VK_CAPITAL = &H14

Sub CapsLockKontrolEtVeDegistir()
    Dim durum As Integer
    durum = GetKeyState(VK_CAPITAL)
   
    If durum = 1 Or durum = -127 Then
        ' CapsLock açık › kapat
        Application.SendKeys "{CAPSLOCK}"
        MsgBox "Caps Lock KAPATILDI"
    Else
        ' CapsLock kapalı › aç
        Application.SendKeys "{CAPSLOCK}"
        MsgBox "Caps Lock AÇILDI"
    End If
End Sub

muratgunay48 · Salı saat 13:21'de

Necdet' Alıntı:
EN küçük sorunlarda ChatGPT ye soruyorum, sağolsun hemen çözüyor.
Tüm kitapta büyük harf yazsın istiyorsanız Caps tuşunu açıp ya da kapatmak daha mantıklı.
ChatGPT amcamın yanıtını buraya ekliyorum. Kodu kendinize göre sadece Büyük harfe çevirebilirsiniz. Kodu dosyayı açtığında otomatik çalıştırabilirsiniz. Nasıl yapılacağını artık sormaıyın15 yıllık üyesiniz.

Kod:

#If VBA7 Then Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer #Else Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer #End If Const VK_CAPITAL = &H14 Sub CapsLockKontrolEtVeDegistir() Dim durum As Integer durum = GetKeyState(VK_CAPITAL) If durum = 1 Or durum = -127 Then ' CapsLock açık › kapat Application.SendKeys "{CAPSLOCK}" MsgBox "Caps Lock KAPATILDI" Else ' CapsLock kapalı › aç Application.SendKeys "{CAPSLOCK}" MsgBox "Caps Lock AÇILDI" End If End Sub

Teşekkür ederim hocam

Büyük harf yazdırma

muratgunay48

mustafa1205

Korhan Ayhan

Administrator

muhasebeciyiz

Korhan Ayhan

Administrator

muratgunay48

muratgunay48

muratgunay48

mustafa1205

Ekli dosyalar

muratgunay48

Necdet

Moderatör

muratgunay48