Hücrenin Değerini Hücre Yorumuna / Açıklamasına Ekleme

walabi · 5 Mart 2025

Merhaba,

Herhangi bir textboxdan belli bir hücreye veri girip , hücreye girilen bu veriyi hücrenin yorum açıklama kısmına aldırmak istiyorum. Bunu nasıl yapabilirim? Aşağıdaki kod ile denemeye çalıştım, olmadı

Kriterlerim şunlar. Hücreye ilk defa veri giriliyorsa ( doğal olarak yorum/açıklama kısmı boş ) , resimde göründüğü gibi "Hareketler:" şeklinde bir satır ekledikten ilk veriyi bir alt satıra eklemek. Sonraki her yeni veri girişini de alt alta eklettirmek.

Aşağıdaki kodda hücrenin açıklaması boş ise bunu yap, değilse şunu yap gibi bir kod düzenlemeye çalıştım, ancak hatalı.

Ve ayrıca bir hücrenin yorum/açıklama kısmına eklenecek karakter sınırlaması var mıdır?

Kod:

Sub deneme()
Dim Hucre As Range
Dim Eski As String

Hucre = Sheets("Yorum").Range("A2")
If Not Hucre Is Nothing Then
    Yeni = Hucre.Value
    If Hucre.Comment.Text = "" Then
    Eski = "Hareketler Listesi:" & Chr(10)
    Else
    Eski = Hucre.Comment.Text
    End If
   
    tarih = Range("c1").Value 'burdaki C1 o günün tarihinin yazdigi hücre.
    Hucre.Comment.Text Text:=Eski & tarih & " / " & Yeni & Chr(10)
End If
End Sub

volki_112 · 5 Mart 2025

walabi' Alıntı:
Merhaba,

Herhangi bir textboxdan belli bir hücreye veri girip , hücreye girilen bu veriyi hücrenin yorum açıklama kısmına aldırmak istiyorum. Bunu nasıl yapabilirim? Aşağıdaki kod ile denemeye çalıştım, olmadı

Kriterlerim şunlar. Hücreye ilk defa veri giriliyorsa ( doğal olarak yorum/açıklama kısmı boş ) , resimde göründüğü gibi "Hareketler:" şeklinde bir satır ekledikten ilk veriyi bir alt satıra eklemek. Sonraki her yeni veri girişini de alt alta eklettirmek.

Aşağıdaki kodda hücrenin açıklaması boş ise bunu yap, değilse şunu yap gibi bir kod düzenlemeye çalıştım, ancak hatalı.

Ve ayrıca bir hücrenin yorum/açıklama kısmına eklenecek karakter sınırlaması var mıdır?

Kod:

Sub deneme() Dim Hucre As Range Dim Eski As String Hucre = Sheets("Yorum").Range("A2") If Not Hucre Is Nothing Then Yeni = Hucre.Value If Hucre.Comment.Text = "" Then Eski = "Hareketler Listesi:" & Chr(10) Else Eski = Hucre.Comment.Text End If tarih = Range("c1").Value 'burdaki C1 o günün tarihinin yazdigi hücre. Hucre.Comment.Text Text:=Eski & tarih & " / " & Yeni & Chr(10) End If End Sub

deneyiniz. Yorumda karakter sınırı 32 bin kusurmuş.

Kod:

Sub deneme()
    Dim Hucre As Range
    Dim Eski As String
    Dim Yeni As String
    Dim tarih As Variant
    
    Set Hucre = Sheets("Yorum").Range("A2") ' Hucre'yi Set ile nesne olarak tanımlıyoruz.
    
    If Not Hucre Is Nothing Then
        Yeni = Hucre.Value ' Hucre'nin değerini Yeni değişkenine atıyoruz
        
        If Hucre.Comment Is Nothing Then ' Yorum olup olmadığını kontrol ediyoruz
            Eski = "Hareketler Listesi:" & Chr(10)
        Else
            Eski = Hucre.Comment.Text ' Var olan yorumu alıyoruz
        End If
        
        tarih = Sheets("Yorum").Range("C1").Value ' C1 hücresindeki tarih değerini alıyoruz
        
        Hucre.AddComment Text:=Eski & tarih & " / " & Yeni & Chr(10) ' Yorum ekliyoruz
    End If
End Sub

walabi · 5 Mart 2025

volki_112' Alıntı:

deneyiniz. Yorumda karakter sınırı 32 bin kusurmuş.

Kod:

Sub deneme()
    Dim Hucre As Range
    Dim Eski As String
    Dim Yeni As String
    Dim tarih As Variant
   
    Set Hucre = Sheets("Yorum").Range("A2") ' Hucre'yi Set ile nesne olarak tanımlıyoruz.
   
    If Not Hucre Is Nothing Then
        Yeni = Hucre.Value ' Hucre'nin değerini Yeni değişkenine atıyoruz
       
        If Hucre.Comment Is Nothing Then ' Yorum olup olmadığını kontrol ediyoruz
            Eski = "Hareketler Listesi:" & Chr(10)
        Else
            Eski = Hucre.Comment.Text ' Var olan yorumu alıyoruz
        End If
       
        tarih = Sheets("Yorum").Range("C1").Value ' C1 hücresindeki tarih değerini alıyoruz
       
        Hucre.AddComment Text:=Eski & tarih & " / " & Yeni & Chr(10) ' Yorum ekliyoruz
    End If
End Sub

Teşekkürler, Açıklamalar için ayrıca teşekkür.

Muzaffer Ali · 5 Mart 2025

Merhaba.
Karakter sınır 32,767 karakterdir.

Alternatif.

Kod:

Sub Test()
    With Sheets("Yorum").Range("A2")
        If .Value <> "" Then
            If .Comment Is Nothing Then
                .AddComment "Hareketler Listesi:" & Chr(10)
            End If
            .Comment.Text .Comment.Text & Date & " - " & .Value & Chr(10)
        End If
    End With
End Sub

walabi · 5 Mart 2025

volki_112' Alıntı:

deneyiniz. Yorumda karakter sınırı 32 bin kusurmuş.

Kod:

Sub deneme()
    Dim Hucre As Range
    Dim Eski As String
    Dim Yeni As String
    Dim tarih As Variant
   
    Set Hucre = Sheets("Yorum").Range("A2") ' Hucre'yi Set ile nesne olarak tanımlıyoruz.
   
    If Not Hucre Is Nothing Then
        Yeni = Hucre.Value ' Hucre'nin değerini Yeni değişkenine atıyoruz
       
        If Hucre.Comment Is Nothing Then ' Yorum olup olmadığını kontrol ediyoruz
            Eski = "Hareketler Listesi:" & Chr(10)
        Else
            Eski = Hucre.Comment.Text ' Var olan yorumu alıyoruz
        End If
       
        tarih = Sheets("Yorum").Range("C1").Value ' C1 hücresindeki tarih değerini alıyoruz
       
        Hucre.AddComment Text:=Eski & tarih & " / " & Yeni & Chr(10) ' Yorum ekliyoruz
    End If
End Sub

Bu satırda hata aldım. Yani ilk değeri ekledikten sonra ikincikez ekleme yapmaya çalıştığımda hata veriyor

Kod:

Hucre.AddComment Text:=Eski & Tarih & " - " & Yeni & Chr(10)

walabi · 5 Mart 2025

Sayın @Muzaffer Ali teşekkürler, istediğim gibi çalışıyor. Ellerinize sağlık. With ile kullanmak daha pratiklik sağlayacaktır.

walabi · 5 Mart 2025

Syn @Muzaffer Ali son olarak aşağıdaki satırları yazdığınız koda nasıl yerleştirebilirim.

Kod:

        .Shape.TextFrame.Characters.Font

        .Name = "Calibri"
        .Size = 11
        .Color = vbBlue
        .Bold = True

mustafa1205 · 5 Mart 2025

walabi' Alıntı:
Syn @Muzaffer Ali son olarak aşağıdaki satırları yazdığınız koda nasıl yerleştirebilirim.

Kod:

.Shape.TextFrame.Characters.Font .Name = "Calibri" .Size = 11 .Color = vbBlue .Bold = True

Sub Test()
With Sheets("Yorum").Range("A2")
If .Value <> "" Then
If .Comment Is Nothing Then
.AddComment "Hareketler Listesi:" & Chr(10)
End If
.Comment.Text .Comment.Text & Date & " - " & .Value & Chr(10)

With .Comment.Shape.TextFrame.Characters.Font
.Name = "Calibri"
.Size = 11
.Color = vbBlue
.Bold = True
End With
End If
End With
End Sub

Bu şekilde bir dener misiniz

walabi · 5 Mart 2025

mustafa1205' Alıntı:
Sub Test()
With Sheets("Yorum").Range("A2")
If .Value <> "" Then
If .Comment Is Nothing Then
.AddComment "Hareketler Listesi:" & Chr(10)
End If
.Comment.Text .Comment.Text & Date & " - " & .Value & Chr(10)

With .Comment.Shape.TextFrame.Characters.Font
.Name = "Calibri"
.Size = 11
.Color = vbBlue
.Bold = True
End With
End If
End With
End Sub

Bu şekilde bir dener misiniz

Teşekkürler Syn @mustafa1205 , çalışıyor. Ellerinize sağlık.

mustafa1205 · 5 Mart 2025

walabi' Alıntı:
Teşekkürler Syn @mustafa1205 , çalışıyor. Ellerinize sağlık.

Kolay Gelsin İyi Çalışmalar Sayın Walabi. Muzaffer Hocamın kodlarına ekleme yaptım sadece. Muzaffer Hocamın ellerine sağlık...

sertkan42 · 5 Mart 2025

Yarımcı olan Üstatların eline sağlık. Sayın @walabi boş bir sayfada kendime uyarlamak istedim ama olmadı dosya paylaşmanız mümkün mü? veya anlatımını yaparsanız sevinirim.

walabi · 5 Mart 2025

@sertkan42 Dosya aslında bu, sitede bir üyenin imalat ile ilgili bir dosyasını ayarlamaya çalışırken bu uygulama aklıma gelmişti. Yorum adlı excel sayfası ve Modül3 deki kodlar direk bu konu ile ilgili.

sertkan42 · 5 Mart 2025

@walabi Teşekkür ederim. Yorum sayfası A2 hücresine farklı veriler girdiğimde açıklamaya ekleme yapmadı ama sizde çalışıyor muydu ?

volki_112 · 5 Mart 2025

sertkan42' Alıntı:
@walabi Teşekkür ederim. Yorum sayfası A2 hücresine farklı veriler girdiğimde açıklamaya ekleme yapmadı ama sizde çalışıyor muydu ?

module 3 e gidip kodu manuel çalıştırmanız gerekli. kodu çalıştırdığınızda değer hücresindeki veri yoruma eklenir. Kodu butona atamamış daha siz butona atayabilirsiniz.

walabi · 5 Mart 2025

@sertkan42 Sizin yapmaya çalıştığınız excel sayfasının değişim olayı ile ilgili. Aşağıdaki kodu yorum sayfasının vba kısmına eklerseniz A2 hücresine her veri girişinde enter dedikten sonra açıklamaya eklemesi gerekiyor. Dosyanın bende çalışan son halini ekledim. Kendi isteğinize göre uyarlamanız gerekir.

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Test2
End Sub

sertkan42 · 5 Mart 2025

Cevaplar için teşekkür ederim arkadaşlar elinize emeğinize sağlık.

Muzaffer Ali · 5 Mart 2025

sertkan42' Alıntı:
@walabi Teşekkür ederim. Yorum sayfası A2 hücresine farklı veriler girdiğimde açıklamaya ekleme yapmadı ama sizde çalışıyor muydu ?

Bu kodu kullanmanız daha doğru olur. Sayın @walabi nin paylaştığı kodu kullanırsanız herhangi bir hücreyi seçtiğinizde çalışır. Bunu istemezsiniz.
Aşağıdaki kodu sayfanın kod kısmına kopyalayın. A2 hücresinde bir değişiklik olduğunda otomatik çalışır.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("A2"), Target) Is Nothing Then
                With Range("A2")
        If .Value <> "" Then
            If .Comment Is Nothing Then
                .AddComment "Hareketler Listesi:" & Chr(10)
            End If
                .Comment.Text .Comment.Text & Date & " - " & .Value & Chr(10)
                With .Comment.Shape.TextFrame.Characters.Font
                    .Name = "Calibri"
                    .Size = 11
                    .Color = vbBlue
                    .Bold = True
                End With
            End If
        End With
    End If
End Sub

Ayrıca Açıklamanın içindeki metne göre boyut değiştirmesini isterseniz.
Açıklama içeren hücreyi sağ tıklatın. "Açıklama Gizle/Göster" seçin. Açılamanın çerçevesini sağ tıklatın "Açıklama Biçimlendir" seçin. Açılan pencerede Hizalama tabını açın "Otomatik Boyutlandır" işaretleyin.

Bunu da kod yapsın isterseniz aşağıdaki kodu kullanın.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("A2"), Target) Is Nothing Then
                With Range("A2")
        If .Value <> "" Then
            If .Comment Is Nothing Then
                .AddComment "Hareketler Listesi:" & Chr(10)
            End If
                .Comment.Text .Comment.Text & Date & " - " & .Value & Chr(10)
                .Comment.Shape.TextFrame.AutoSize = True
                With .Comment.Shape.TextFrame.Characters.Font
                    .Name = "Calibri"
                    .Size = 11
                    .Color = vbBlue
                    .Bold = True
                End With
            End If
        End With
    End If
End Sub

sertkan42 · 5 Mart 2025

@Muzaffer Ali Hocam bende aynı sorundan bahsedecekken sorunun çözümünü paylaşmışsınız bile. Çok teşekkürler elinize sağlık.

walabi · 5 Mart 2025

Tek kelimeyle MUAZZAM.

Hücrenin Değerini Hücre Yorumuna / Açıklamasına Ekleme

walabi

Ekli dosyalar

volki_112

walabi

Muzaffer Ali

Destek Ekibi

walabi

walabi

walabi

mustafa1205

walabi

mustafa1205

sertkan42

walabi

Ekli dosyalar

sertkan42

volki_112

walabi

Ekli dosyalar

sertkan42

Muzaffer Ali

Destek Ekibi

sertkan42

walabi