Label Caption Değerini Hücreye Yazdırma

[unfors]

Dim TB As OLEObject

Set TB = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Label.1", Link:=False, _
        DisplayAsIcon:=False, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=ActiveCell.Width, Height:=ActiveCell.Height)

With TB
        .Placement = xlMoveAndSize
        .PrintObject = True
    End With

Kod ile Sayfada ActiveCell'e Label Ekliyorum. İstediğim şu Label'ın Caption değeri herzaman üzerindeki hücrenin değerine eşit olsun

 

[Asri]

Deneyiniz.


Modül 1 e aşağıdaki kodu ekleyniz.

Public TB As OLEObject

Public Sub label_caption()
   Set TB = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Label.1", Link:=False, _
        DisplayAsIcon:=False, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=ActiveCell.Width, Height:=ActiveCell.Height)
   With TB
        .Placement = xlMoveAndSize
        .Name = ActiveCell.Address
        .PrintObject = True
        .Object.Caption = ActiveCell.Value
   End With
End Sub

Sayfanın kod bölümüne de aşağıdaki kodu ekleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    For Each ole In ActiveSheet.OLEObjects
       If ole.Name = Target.Address Then ole.Object.Caption = Target.Value
    Next
End Sub

 

[unfors]

Bu sadece değerleri eşitler. Sayfaya gönderdikten sonra hücre değeri değişse bile Label aynı kalır. Benim istediğim gönderdikten sonra hücre değeri değişince Label'da değişsin.

 

[hamitcan]

Aşağıdaki kodu ilgili sayfanın kod kısmına ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
Set TB = ActiveSheet.OLEObjects(1)
   With TB
        .Object.Caption = Target.Value
   End With
End Sub

 

[Asri]

Bu sadece değerleri eşitler. Sayfaya gönderdikten sonra hücre değeri değişse bile Label aynı kalır. Benim istediğim gönderdikten sonra hücre değeri değişince Label'da değişsin.

2. nolu mesajda kod güncellendi.

 

[unfors]

Gerçekten çok teşekkür ederim. Çok sağolun. Süper oldu