ResizeCommentsInSelection

[sujee]

Merhaba,

aşağıdaki kodu, Private Sub Worksheet_SelectionChange(ByVal Target As Range) bölümünde yorumları tekrardan boyutlandırmak için kullanıyorum fakat yorumlu bir alanı kopyalayıp başka bir yorumlu alanın üzerine kopyalamak istediğimde kod yeniden çalışıyor ve "Yapıştır" komutu aktif görünmüyor.

Yardımcı olabilir misiniz?

Sub ResizeCommentsInSelection()
'Posted by Dave Peterson 2002-02-25
Dim mycell As Range
Dim myRng As Range
Dim lArea As Long

Set myRng = Selection


For Each mycell In myRng.Cells
'For Each mycell In Range("b3:ak" & Range("b1500").End(3).Row)
If Not (mycell.Comment Is Nothing) Then
With mycell.Comment
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 300 Then
lArea = .Shape.Width * .Shape.Height
.Shape.Width = 200
.Shape.Height = (lArea / 200) * 1.2
End If
End With
End If
Next mycell
End Sub

 

[sujee]

çok mu zor ?

 

[Levent Menteşoğlu]

Zor olan örnek dosya olmadan çözüm önermektir.

 

[Korhan Ayhan]

Merhaba,

Anladığım kadarıyla kopyalama esnasında kodun çalışmasını istemiyorsunuz. Aşağıdaki kod satırını kodlarınızın en üstüne eklerseniz istediğiniz sonuca ulaşırsınız.

If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub

 

[sujee]

Çok teşekkür ederim korhan bey