Feedback by UserVoice

How can we improve Excel for Windows (Desktop Application)?

Allow pictures/images/graphic as a pop up when hovered over. Link images. Embed Images

Similar to the current comments, allow images the ability to pop up when hovering over a cell.

This would have a similar problem to comments however; comments remained fixed to cell even if data is moved.

It would be great if cell images also moved with the cell data.

For example; I have created a spread sheet that will import data from my invoice and place that data into a stock list. I would very much like images to be linked and embed to an item code or item description, and for those linked images to move with my stock list. This is necessary if an invoice includes new items.

I currently use the comment->fill->picture options. This is very time consuming however, and the comments do not move if a new item is added and the alphabetical sort places the new item above the comment picture. All my comment pictures are then a row out of place.

The code below is what I am currently using to update my stock list, and also remove the comment author because it is a naissance.

Thanks for all your work.

Sub RemoveUserNames()
Dim MyComment As Comment
Dim I As Integer
'Start looping through comments
For Each MyComment In ActiveSheet.Comments
'Find the position number of the Colon & LineFeed character combination
I = InStr(1, MyComment.Shape.TextFrame.Characters.Text, ":" & vbLf)
'Use the position number to reset the comment text to all but the user name
If I > 0 Then
MyComment.Shape.TextFrame.Characters.Text = _
Mid(MyComment.Shape.TextFrame.Characters.Text, I + 2)
MyComment.Shape.TextFrame.Characters.Font.Bold = False
End If
'Go to the next comment
Next MyComment
End Sub
Sub print_unique_Stocklist()

Application.ScreenUpdating = False

Dim v
v = getUniqueArray(ThisWorkbook.Worksheets("Ordered Stock").Range("$B$2:$B$1048576"))

If IsArray(v) Then
ThisWorkbook.Worksheets("Stocklist").Range("A2").Resize(UBound(v)) = v
End If

Application.ScreenUpdating = True
ActiveSheet.EnableCalculation = True

End Sub

Public Function getUniqueArray(inputRange As Range, _
Optional skipBlanks As Boolean = True, _
Optional matchCase As Boolean = True, _
Optional prepPrint As Boolean = True _
) As Variant

Dim vDic As Object
Dim tArea As Range
Dim tArr As Variant, tVal As Variant, tmp As Variant
Dim noBlanks As Boolean
Dim cnt As Long

On Error GoTo exitFunc:
If inputRange Is Nothing Then GoTo exitFunc

With inputRange
If .Cells.Count < 2 Then
ReDim tArr(1 To 1, 1 To 1)
tArr(1, 1) = .Value2
getUniqueArray = tArr
GoTo exitFunc
End If

Set vDic = CreateObject("scripting.dictionary")
If Not matchCase Then vDic.compareMode = vbTextCompare

noBlanks = True

For Each tArea In .Areas
tArr = tArea.Value2
For Each tVal In tArr
If tVal <> vbNullString Then
vDic.Item(tVal) = Empty
ElseIf noBlanks Then
noBlanks = False
End If
End With

If Not skipBlanks Then If Not noBlanks Then vDic.Item(vbNullString) = Empty

'this is done just in the case of large data sets where the limits of
'transpose may be encountered
If prepPrint Then
ReDim tmp(1 To vDic.Count, 1 To 1)
For Each tVal In vDic.Keys
cnt = cnt + 1
tmp(cnt, 1) = tVal
getUniqueArray = tmp
getUniqueArray = vDic.Keys
End If

Set vDic = Nothing

End Function

2 votes
Sign in
Sign in with: Facebook Google
Signed in as (Sign out)

We’ll send you updates on this idea

Good News Apparel shared this idea  ·   ·  Flag idea as inappropriate…  ·  Admin →


Sign in
Sign in with: Facebook Google
Signed in as (Sign out)

Feedback and Knowledge Base