View JPEG file

[gconrad]

I have stored the full path and file name to a JPG file in a cell. I have a command button titled "Open" next to the cell. How do I cause the image to be displayed when the button is clicked?

There would also need to be a way to close the image.

 

[jonathann3891]

Shell "your\path\here\image.jpg"

 

[Logit]

.

Option Explicit


Sub Picture()
Application.ScreenUpdating = False


Range("A6").Select 'This is where picture will be inserted
ActiveSheet.Pictures.Insert("C:\Users\My\Desktop\cute-red-kitten-forgot-something-r-default.jpg").Select
'Path to where pictures are stored - Edit as required


'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
.Left = Range("A6").Left                '<--- change cell as required
.Top = Range("A6").Top                  '<--- change cell as required
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 100#
.ShapeRange.Rotation = 0#
End With


Exit Sub


ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub

Application.ScreenUpdating = True



End Sub



Sub deleteImage()
    Dim Pict As Shape
    Dim Cel As Range
    Set Cel = Sheets("Sheet1").Range("A6")
    Dim Caddress As String
    Caddress = Cel.Address
    Application.ScreenUpdating = False
    For Each Pict In Sheets("Sheet1").Shapes 'Check for each picture in the range
        If Pict.Type = msoPicture Then
            If Pict.TopLeftCell.Address = Caddress Or Pict.BottomRightCell.Address = Caddress Then
                Pict.Delete
                Exit Sub
            Else:
                MsgBox "Doesn't exists a picture in the range"
                Exit Sub
            End If
        End If
    Next Pict
    Application.ScreenUpdating = True
End Sub

 

[gconrad]

Thank you - see below for the code so far
still need to:
1. Maintain aspect ratio of the pic
2. Enlarge the photo to fit within the new screen
3. No save option when closing the viewer window

Sub ViewPic()
filename = Range("DQ3").Value ' This cell in current window contains full path & file name
Application.ScreenUpdating = False
Workbooks.Open Range("Viewer").Value 'this is a named range in current window that contains path a& file name to a blank excel workbook I am using as a pop up window for this
Range("A1").Select
ActiveSheet.Pictures.Insert(filename).Select
With Selection
.Left = Range("A1").Left
.Top = Range("A1").Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 100#
.ShapeRange.Rotation = 0#
End With
Application.ScreenUpdating = True
End Sub

 

[gconrad]

updated - modified code as below to accomplish 1 & 2

Thank you - see below for the code so far
still need to:
1. Maintain aspect ratio of the pic
2. Enlarge the photo to fit within the new screen
3. No save option when closing the viewer window

Sub ViewPic()
filename = Range("DQ3").Value ' This cell in current window contains full path & file name
Application.ScreenUpdating = False
Workbooks.Open Range("Viewer").Value 'this is a named range in current window that contains path a& file name to a blank excel workbook I am using as a pop up window for this
Range("A1").Select
ActiveSheet.Pictures.Insert(filename).Select
With Selection
.Left = Range("A1").Left
.Top = Range("A1").Top
.ShapeRange.LockAspectRatio = True
.ShapeRange.Height = Application.ActiveWindow.UsableHeight
.ShapeRange.Rotation = 0#
End With
Application.ScreenUpdating = True