Target.Offset(0, -1) açıklama eklendiğinde açıklmanın metinkutusu boyutları hücreye e

[hsayar]

Target.Offset(0, -1) açıklama eklendiğinde açıklmanın metinkutusu boyutları Target.Offset(0, -1) hücresine eşit olsun. Mümkünmüdür.

http://www.excel.web.tr/showthread.php?t=46375
linkinde bir soru için verdiğim kodlar aşağıdadır.
Kırmızı alanı makro kaydet ile oluşturduğum kodlardan kalma. ama ben bu alanları Hedef hücrenin sol yanı ile eşitlemek istiyorum.
Nasıl olmalı.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b3:b1000]) Is Nothing Then Exit Sub       'Değişen Hücre B3:B1000 aralığında ise
If Target.Count > 1 Then Exit Sub                               'Seçili hücre sayısı 1 den büyük ise işlem iptal edilir.
Dim dsYol, Dosya, ActHcr As String                              'Değişkenler tanımlanır
Dim Fso As Object                                               ' ***

ActHcr = ActiveCell.Address                                     'Geilne hücre adresi sabitlenir.
    On Error Resume Next
    Target.Offset(0, -1).ClearComments                          'Solumzudaki hücredki açıklma kaldırılır.
    On Error GoTo 0
    If Target.Value = "" Then GoTo Son                          'Eğer Target (Bx) boşsa Son altprosodürüne geçilir.
[COLOR=Black]dsYol = "c:\Resim"        [/COLOR]  'ThisWorkbook.Path                  'Burada dosyanın bulunduğu klasör yer alır
'dsYol = ThisWorkbook.Path                  'Burada dosyanın bulunduğu klasör yer alır
Dosya = dsYol & "\s0" & Target.Value & ".gif"
 
Set Fso = CreateObject("Scripting.FileSystemObject")              'Dosya kontorol objesine değer ata
If Fso.FileExists(Dosya) = False Then Dosya = dsYol & "\yok.gif"  'belirtilen klasörde hedef ile eşleşne resim yok ise yok gifi alınır.
    
    With Target.Offset(0, -1)                                     'Solumzudaki hücreye
                .AddComment                                       'açıklama ekle
                .Comment.Visible = True                           ' Görünür olsun
                .Comment.Text Text:=" "                           ' içi boş olsun
                .Comment.Shape.Select True                        ' Metin kutusunu seç
    End With
    With Selection.ShapeRange
                        .Fill.UserPicture (Dosya)                 ''Dolgu olarak resim kullan
[B][COLOR=Red]                         .IncrementLeft -189#                      'Mevcut sol konumunu deiştir.
                        .IncrementTop 6#                          'Mevcut üst konumunu deiştir.
                        .ScaleWidth 1.65, msoFalse, msoScaleFromTopLeft    'soldan-sağa ne kadar uzun
                        .ScaleHeight 2.04, msoFalse, msoScaleFromTopLeft   'üstten-aşağı ne kadar uzun[/COLOR][/B]
    End With
    
Son:
Set Fso = Nothing
Range(ActHcr).Select
End Sub

 

[Ferhat Pazarçevirdi]

Yani, kısaca; siz, A2 hücresine "Açıklama" eklendiğinde; "Açıklama"nın A1 hücresinde, A1 hücresinin boyutlarında mı görünmesini istiyorsunuz ?

 

[hsayar]

Şöyle hocam istediğim
B2 değişince
A2 hücresine açıklma ekle ve açıklama a2 hücresi ile aynı boyutta olsun idi
ama açıklamalar yazıcıdan çıkartılamadığı için iş değişti.

B2 değişince
A2 hücresine metin kutusu eklenecek ve metin kutusu a2 hücresi ile aynı boyutta olacak hocam.

Nihai amaç excel93 dolgu olarak resim kullandırtmadığı için A sütunundaki x Hücresinin üzerini metin kutusu ile kamufle edip dolgu olarak stok resmi kullanmaktır.

 

[Ferhat Pazarçevirdi]

Aşağıdaki yapıyı inceleyiniz ve kendinize adapte ediniz.

Sub Deneme1()
Dim oAck As Comment
Dim oHcr As Range
Set oHcr = ActiveCell.Offset(0, -1)
Set oAck = oHcr.AddComment
With oAck
     .Text Text:=" "
      With .Shape
           .Left = oHcr.Left
           .Top = oHcr.Top
           .Width = oHcr.Width
           .Height = oHcr.Height
           .Fill.UserPicture (dosya)
      End With
     .Visible = True
End With
Set oAck = Nothing
Set oHcr = Nothing
End Sub

 

[hsayar]

Teşekkür ederim hocam bu benim isteğimi karşılıyor...