Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
1.1k views
in Technique[技术] by (71.8m points)

vba - Hover preview over excel image link

I wanted to know is it possible to preview image links by hovering mouse cursor over image urls in excel, or google sheets, or any spreadsheet editor.

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

You made me curious, so I looked into this.

The answer is, yes - it requires a bit of VBA and is a bit hacky, but here's how you can do it.

First of all, doing anything on cell hover in excel is a bit hacky.

To do so, we use the HYPERLINK formula of a cell.

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

In this case, I have the URL of a grumpycat picture in my formula.

I also pass this link to a function I create called OnMouseOver

Dim DoOnce As Boolean
Public Function OnMouseOver(URL As String)
If Not DoOnce Then
    DoOnce = True
    With ActiveSheet.Pictures.Insert(URL)
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Width = 75
            .Height = 100
        End With
        .Left = Cells(1, 2).Left
        .Top = Cells(1, 2).Top
        .Placement = 1
        .PrintObject = True
    End With
End If
End Function

Finally, in order to clear it when we hover away, we have to put some formulas in the other cells near it.

=HYPERLINK(Reset())

And the associated function:

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

Results: Results

Edit

Expanding on this with multiple links.

We can pass a cell reference along with this to do this with multiple links and have them appear next to the cell.

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

Results2


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...