Image viewer in excel

msaiyad

Board Regular
Joined
Mar 23, 2008
Messages
93
I want to set a image viewer with excel where I select any cell read that cell and show the same image in that viewer
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
<?xml:namespace prefix = v ns = "urn:schemas-microsoft-com:vml" /><v:rect id=_x0000_s1026 style="MARGIN-TOP: 12.6pt; Z-INDEX: 1; MARGIN-LEFT: 207pt; WIDTH: 117pt; POSITION: absolute; HEIGHT: 81pt"></v:rect><o:p> <TABLE cellSpacing=0 cellPadding=0 width="100%"><TBODY><TR><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">
<o:p></o:p>​
Image viewer

</TD></TR></TBODY></TABLE>
</o:p>


A
1 Abc_xy45
2 xyz_er45
(these all are style no )
<o:p></o:p>
<o:p></o:p>
<o:p></o:p>
<o:p></o:p>
I made a folder where I store all images with style no
it will be same no in A Column
So when I select any style no I can able to see image in image viewer is this possible ?Plz help
 
Here is some code that should be easy to change :-
Code:
'=============================================================
'- GET A PICTURE FROM A FOLDER INTO A WORKSHEET
'- DOUBLE CLICK CELL CONTAINING PICTURE FILE NAME TO OPEN IT
'- Code goes into Worksheet module. Right click tab. View Code
'- Brian Baulsom 2008
'==============================================================
'================================================================================
'- DOUBLE CLICK CODE
'================================================================================
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim MyFolder As String
    Dim MyFile As String
    Dim ws As Worksheet
    Dim MyCell As Range         ' cell for picture
    Dim MyGallery As ShapeRange ' ALL PICTURES IN THE SHEET
    '----------------------------------------------------------------------------
    '- Folder & File name
    MyFolder = "F:\My Pictures\"
    MyFile = MyFolder & Target.Value    ' CELL VALUE
    '------------------------------------------------------
    Application.ScreenUpdating = False
    Set ws = ActiveSheet
    '------------------------------------------------------
    '- clear all existing pictures
    On Error Resume Next        ' might be no pictures yet
    Set MyGallery = ws.Pictures.ShapeRange
    MyGallery.Delete
    On Error GoTo 0             ' reset error trap to normal
    '------------------------------------------------------
    '- CELL SIZE
    Set MyCell = ws.Range("D1")
    MyCell.ColumnWidth = 21
    MyCell.RowHeight = 102
    '------------------------------------------------------
    '- INSERT PICTURE & RESIZE TO SAME AS CELL
    ws.Pictures.Insert(MyFile).Select
    With Selection
        .Top = MyCell.Top
        .Left = MyCell.Left
        .Width = MyCell.Width
        .Height = MyCell.Height
        .Placement = xlMoveAndSize
        .PrintObject = True
    End With
    '------------------------------------------------------
    '- remove focus from picture
    MyCell.Select
    Application.ScreenUpdating = True
End Sub
'============================================================================


Here is some code to get file names into a worksheet :-
Code:
'=========================================================
'- GET PICTURE FILE NAMES FROM A FOLDER INTO A WORKSHEET
'=========================================================
Private Sub GetPictures()
    Dim MyFolder As String
    Dim MyFile As String
    Dim rw As Long
    '-----------------------------------------------------
    MyFolder = "F:\My Pictures\"
    MyFile = Dir(MyFolder & "*.jpg")
    rw = 1      ' row number
    '-----------------------------------------------------
    Do While MyFile <> ""
        ActiveSheet.Cells(rw, "A").Value = MyFile
        rw = rw + 1
        MyFile = Dir
    Loop
    '-----------------------------------------------------
End Sub
'===========================================================
 
Upvote 0
'- INSERT PICTURE & RESIZE TO SAME AS CELL
ws.Pictures.Insert(MyFile).Select

Showing error plz help:)
 
Upvote 0
Re: Image viewer in excel error 1004

Runtime error 1004
Unable to get the insert property of the Pictures class
 
Upvote 0
Have you changed the text here:

MyFile = MyFolder & Target.Value

to something like MyFile = "C:\myfolder\" & Target.Value ?
 
Upvote 0
yFolder = "D:\Documents and Settings\mudassar\Desktop\photos"
MyFile = MyFolder & Target.Value ' CELL VALUE


I change URL Only
 
Upvote 0
'- DOUBLE CLICK CELL CONTAINING PICTURE FILE NAME TO OPEN IT
'- Code goes into Worksheet module. Right click tab. View Code
'- Brian Baulsom 2008
'==============================================================
'================================================================================
'- DOUBLE CLICK CODE
'================================================================================
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim MyFolder As String
Dim MyFile As String
Dim ws As Worksheet
Dim MyCell As Range ' cell for picture
Dim MyGallery As ShapeRange ' ALL PICTURES IN THE SHEET
'----------------------------------------------------------------------------
'- Folder & File name
MyFolder = "D:\Documents and Settings\mudassar\Desktop\photos"
MyFile = MyFolder & Target.Value ' CELL VALUE
'------------------------------------------------------
Application.ScreenUpdating = False
Set ws = ActiveSheet
'------------------------------------------------------
'- clear all existing pictures
On Error Resume Next ' might be no pictures yet
Set MyGallery = ws.Pictures.ShapeRange
MyGallery.Delete
On Error GoTo 0 ' reset error trap to normal
'------------------------------------------------------
'- CELL SIZE
Set MyCell = ws.Range("D1")
MyCell.ColumnWidth = 150
MyCell.RowHeight = 102
'------------------------------------------------------
'- INSERT PICTURE & RESIZE TO SAME AS CELL

:confused: ws.Pictures.Insert(MyFile).Selection
With Selection
.Top = MyCell.Top
.Left = MyCell.Left
.Width = MyCell.Width
.Height = MyCell.Height
.Placement = xlMoveAndSize
.PrintObject = True
End With
'------------------------------------------------------
'- remove focus from picture
MyCell.Select
Application.ScreenUpdating = True
End Sub
'============================================================================
and one more thing i when i change cell by using arrow key mean got focas event i want to change the pic kindly read and plz help on it
thanks
 
Upvote 0
WHat about changing

MyFolder = "D:\Documents and Settings\mudassar\Desktop\photos"

to

MyFolder = "D:\Documents and Settings\mudassar\Desktop\photos\"
 
Upvote 0
and also change

ws.Pictures.Insert(MyFile).Selection
to
ws.Pictures.Insert(MyFile).Select
 
Upvote 0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top