Makro ile seçili hücreye açıklama ekleme

[aureliane]

selamlar. şöyle bir kodum var, seçili hücreye açıklama ekleyebiliyorum fakat girdiğim metnin uzunluğuna göre açıklama kutusu boyu otomatik ayarlansın istiyorum. arama da bir şeyler buldum ama uyarlayamadım.

kodum şu şekilde;

Sub input_comment()
ActiveSheet.Unprotect
Dim pir
Dim n As Variant
Dim l As Long
pir = InputBox("Açıklama Giriniz.")
n = ActiveCell.NoteText
l = Len(n)
If l > 0 Then
ActiveCell.NoteText Text:=" / " & pir, Start _
:=l + 1
Else

ActiveCell.NoteText Text:=pir
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End If
End Sub

 

[muhasebeciyiz]

Sub input_comment()
    
    ActiveSheet.Unprotect
    Dim pir As String
    pir = InputBox("Açıklama Giriniz:")
    
    Dim n As String
    n = ActiveCell.NoteText
  
    Dim l As Long
    l = Len(n)
    
    If l > 0 Then
        ActiveCell.NoteText Text:=" / " & pir, Start:=l + 1
    Else
        ActiveCell.NoteText Text:=pir
    End If
  
    With ActiveCell.Comment
        .Shape.TextFrame.AutoSize = True
        
        Dim commentLength As Long
        commentLength = Len(.Text)

        Dim estWidth As Double
        Dim estHeight As Double
        estWidth = 6 * Application.Max(10, commentLength)
        estHeight = 20 + (commentLength \ 30) * 15
        
        .Shape.Width = estWidth
        .Shape.Height = estHeight
    End With
    
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
        
End Sub

Denermisiniz

 

[aureliane]

Çok teşekkürler, gayet güzel.