Thread: Mouseover image
View Single Post
 
Old 05-02-2015, 01:03 AM
Catalin.B Catalin.B is offline Windows Vista Office 2010 32bit
Expert
 
Join Date: May 2011
Location: Iaşi, Romānia
Posts: 386
Catalin.B is on a distinguished road
Default

Hi Igorr,
Is there a reason behind this prefference?
You can use a code to load images in comments, and after this is done, you will not depend on macros to view the images, it will work even without macros enabled...

You can try the file attached for another possibility.
I used the LoadImagePath procedure to insert the images from a folder named Images, located in the same folder where this workbook is saved. (the images are already inserted, no need to run the code again, only if you want to change the images)
Code:
Sub LoadImagePath()
Dim Types As String, Nm As String
Types = "JPEG Image, PNG Image" 'add more types if needed
Dim Dest As Worksheet, i As Integer, oFso As Object, Img As Object
Set Dest = Worksheets("Mouse Over")
Set oFso = CreateObject("Scripting.FileSystemObject")
i = 2
For Each Img In oFso.getfolder(ThisWorkbook.Path & "\Images").Files
    If InStr(Types, Img.Type) > 0 Then
            Dest.Cells(i, "A") = Img.Path
            Rows(i).RowHeight = 75
            Nm = Mid(Dest.Cells(i, "A").Text, InStrRev(Dest.Cells(i, "A").Text, "\") + 1, InStr(Dest.Cells(i, "A").Text, ".") - InStrRev(Dest.Cells(i, "A").Text, "\") - 1)
            DoEvents
            Application.Goto Dest.Cells(i, "B")
            Dest.Pictures.Insert(Dest.Cells(i, "A").Text).Select
            Selection.Height = 75
            Selection.Name = Nm
     '      Dest.Cells(i, "E") = Img.Type
            i = i + 1
    End If
Next
End Sub
The ShowHide function below, will react when called from the Hyperlink function used in cells from columns B and C:
Code:
Function ShowHideImage(Rw As Integer, ViewOption As Boolean)
Dim Nm As String
Dim Dest As Worksheet
Set Dest = Worksheets("Mouse Over")
Nm = Mid(Dest.Cells(Rw, "A").Text, InStrRev(Dest.Cells(Rw, "A").Text, "\") + 1, InStr(Dest.Cells(Rw, "A").Text, ".") - InStrRev(Dest.Cells(Rw, "A").Text, "\") - 1)

If ViewOption Then
    Dest.Shapes(Nm).Height = 75
Else
    Dest.Shapes(Nm).Height = 0
End If

End Function
Attached Files
File Type: xlsm Show images on mouseOver.xlsm (20.7 KB, 18 views)
Reply With Quote