Hücre içindeki köprüyü ön izleme

[doganayfidaan]

Merhaba forum sakinleri,
Aklımda bi soru var. A1 hücresinde bi linkim var bu linkin üstüne geldiğimde gideciği sayfayı önizleme şansım varmı yada a1 hücresindeki linki b1 hücresinde resim gibi önizleme olarak gösterme şansımız var mı ?
Saygılarımla.

 

[doganayfidaan]

Güncel

 

[doganayfidaan]

Güncel

 

[Asri]

Bu konuyu inceleyin.

https://stackoverflow.com/questions/43923102/hover-preview-over-excel-image-link

A1 e yapıştırıp aşağı çekerek çoğaltıp mouse ile linklerin üstünde ilerleyin

=HYPERLINK(OnMouseOver("http://i.imgur.com/rQ5G8sZ.jpg";A2);"http://i.imgur.com/rQ5G8sZ.jpg")

Modul1 e ekleyin.

Dim DoOnce As Boolean
Public Function OnMouseOver(URL As String, TheCell As Range)
Reset
If Not DoOnce Then
    DoOnce = True
    With ActiveSheet.Pictures.Insert(URL)
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Width = 300
            .Height = 200
        End With
        .Left = Cells(TheCell.Row, TheCell.Column + 1).Left
        .Top = Cells(TheCell.Row, TheCell.Column + 1).Top
        .Placement = 1
        .PrintObject = True
    End With
End If
End Function

Public Function Reset()
If DoOnce Then
    DoOnce = False
    ActiveSheet.Pictures.Delete
End If
End Function

 

[doganayfidaan]

Bu konuyu inceleyin.

https://stackoverflow.com/questions/43923102/hover-preview-over-excel-image-link

A1 e yapıştırıp aşağı çekerek çoğaltıp mouse ile linklerin üstünde ilerleyin

=HYPERLINK(OnMouseOver("http://i.imgur.com/rQ5G8sZ.jpg";A2);"http://i.imgur.com/rQ5G8sZ.jpg")

Modul1 e ekleyin.

Dim DoOnce As Boolean
Public Function OnMouseOver(URL As String, TheCell As Range)
Reset
If Not DoOnce Then
    DoOnce = True
    With ActiveSheet.Pictures.Insert(URL)
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Width = 300
            .Height = 200
        End With
        .Left = Cells(TheCell.Row, TheCell.Column + 1).Left
        .Top = Cells(TheCell.Row, TheCell.Column + 1).Top
        .Placement = 1
        .PrintObject = True
    End With
End If
End Function

Public Function Reset()
If DoOnce Then
    DoOnce = False
    ActiveSheet.Pictures.Delete
End If
End Function

Hocam yapamadım.Örnek bir dosya yükleme şansınız varmı.Sahibinden sitesindeki ilanı ön izlemek için istiyorum.Saygılarımla.

 

[Asri]

Excel de makroların etkin olması gerekiyor.

WeTransfer | Send Large Files Fast - Up To 2GB Free

The simple, quick and secure way to send your files around the world without an account. Share your files, photos, and videos today for free.

we.tl