• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

Katılım
11 Şubat 2023
Mesajlar
48
Excel Vers. ve Dili
c,python,ardunio
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.
 
Bu konuyu inceleyin.


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

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

Modul1 e ekleyin.

C#:
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
 
Bu konuyu inceleyin.


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

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

Modul1 e ekleyin.

C#:
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.
 
Excel de makroların etkin olması gerekiyor.

 
Geri
Üst