Aktif hücrede başka sayfanın görüntüsü

[bendiler]

Tam olarak şöyle izah edeyim;
aktif hücreye açıklama ekleyip o açıklama penceresinde belirledeğim bir sayfanın görüntüsünü otomatik yani üzerine gittiğimde gözükecek şekilde nasıl görebilrim?
bunu Renkler Ve Çizgiler/Renk/Dolgu Efektleri/Resimseç bölümünde başka dosyalar için yapabiliyoruz ama benim istediğim çalıştığım dosyada bulunan örneğin sayfa1 de çalışıyorsam sayfa 1 a1 hücresine açıklama eklediğimde ve üzerine gittiğimde sayfa2 de belirlediğim aralıktaki tablonun otomatikman gözükmesi
Teşekkürler..........

 

[bendiler]

galiba zor bir istekte bulundum

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

Kullanılan kodlar Sn. Ferhat PAZARÇEVİRDİ beye aittir.


Boş bir modüle uygulayın.

Public shp As Picture
 
Sub ResimCek(rg As Range)
 
    For Each shp In ActiveSheet.Pictures
        If shp.Name = "SAYFA2" Then
            shp.Delete
            Exit For
        End If
    Next
 
    rg.CopyPicture xlScreen, xlPicture
    ActiveSheet.Paste
 
    Set shp = Selection
 
    With shp
        .Interior.ColorIndex = 6
        .Name = "SAYFA2"
        .Height = .Height * 1.5
        .Width = .Width * 1.5
        .Left = rg.Width / 2
        .Top = rg.Top / 2
        .OnAction = "ResimSil"
    End With
End Sub
 
Private Sub ResimSil()
    shp.Delete
End Sub
 
Sub Auto_Close()
    If Not shp Is Nothing Then
        shp.Delete
        Set shp = Nothing
    End If
End Sub

Sayfa1 in kod bölümüne uygulayın.

Public ALAN As Range
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A1")) Is Nothing Then
    Set ALAN = Sheets("Sayfa2").Range("A1:C10")
        If Target.Cells.Count = 1 Then
            Call ResimCek(ALAN)
            Target.Select
        Else
 
            Call ResimCek(ALAN)
            Cells(Target.Row, Target.Column).Select
        End If
    Else
        On Error Resume Next
        If Not shp Is Nothing Then
            shp.Delete
            Set shp = Nothing
        End If
        On Error GoTo 0
 
    End If
End Sub