Hi Mike,
I posted that on the OzGrid forum.
http://www.ozgrid.com/forum/showthread.php?t=21863
Here is the complete code.
You need a userform with the following controls;
3 CommandButtons
1 Image control
1 Frame control.
'------Code start
Option Explicit
Const MAX_ZOOM = 4 ' 400% original size
Const MIN_ZOOM = 0.2 ' 20% original size
Private m_sngWidth As Single
Private m_sngHeight As Single
Private m_sngZoom As Single
Sub LoadImage(Name As String)
If Dir(Name) < "" Then
With Image1
.AutoSize = True
.Picture = LoadPicture(Name)
m_sngHeight = .Height
m_sngWidth = .Width
.AutoSize = False
.PictureSizeMode = fmPictureSizeModeStretch
m_sngZoom = 1
.Left = 1
.Top = 1
End With
SetZoom m_sngZoom
Else
MsgBox "Unable to load image " & Chr(10) & Name, vbExclamation
End If
End Sub
Sub SetZoom(Zoom As Single)
With Image1
.Width = m_sngWidth * Zoom
.Height = m_sngHeight * Zoom
End With
Label1.Caption = "Zoom " & Format(Zoom, "0%")
With Frame1
.ScrollHeight = Image1.Height + 2
.ScrollWidth = Image1.Width + 2
End With
End Sub
Private Sub CommandButton1_Click()
m_sngZoom = m_sngZoom + 0.1
If m_sngZoom MAX_ZOOM Then m_sngZoom = MAX_ZOOM
CommandButton1.Enabled = m_sngZoom < MAX_ZOOM
CommandButton2.Enabled = m_sngZoom < MIN_ZOOM
SetZoom m_sngZoom
End Sub
Private Sub CommandButton2_Click()
m_sngZoom = m_sngZoom - 0.1
If m_sngZoom < MIN_ZOOM Then m_sngZoom = MIN_ZOOM
CommandButton2.Enabled = m_sngZoom < MIN_ZOOM
CommandButton1.Enabled = m_sngZoom < MAX_ZOOM
SetZoom m_sngZoom
End Sub
Private Sub CommandButton3_Click()
Dim vntFile
Dim strFilters As String
strFilters = "All Image files,*.bmp;*.gif;*.jpg;*.jpeg,Bitmap
(*.bmp),*.bmp"
vntFile = Application.GetOpenFilename(strFilters)
If vntFile < "" Then
TextBox1.Text = vntFile
LoadImage TextBox1.Text
End If
End Sub
Private Sub UserForm_Initialize()
Image1.BorderStyle = fmBorderStyleNone
End Sub
'-----Code End
Cheers
Andy
Mike wrote:
Hello,
Some time ago, I downloaded or copied/pasted an Excel
file/routine that contains various macros and an Excel
Form. The Form contains a browse button that allows a
user to browse to a directory and select a picture. The
picture is shown in an image control on the Form, which
also contains "Zoom" buttons that allows a user to
expand/reduce the selected picture.
I cannot remember where I got the routine. The purpose of
this post is to identify the author as I need to obtain
copyright clearance.
The macros behind the Form include the following:
Option Explicit
Const MAX_ZOOM = 4 ' 400% original size
Const MIN_ZOOM = 0.2 ' 20% original size
Private m_sngWidth As Single
Private m_sngHeight As Single
Private m_sngZoom As Single
Sub LoadImage(Name As String)
If Dir(Name) < "" Then
With Image1
.AutoSize = True
.Picture = LoadPicture(Name)
m_sngHeight = .Height
m_sngWidth = .Width
.AutoSize = False
.PictureSizeMode = fmPictureSizeModeStretch
m_sngZoom = 1
.Left = 1
.Top = 1
End With
SetZoom m_sngZoom
Else
MsgBox "Unable to load image " & Chr(10) & Name,
vbExclamation
End If
End Sub
Does anyone recognize the above?
BTW, it is not Mr. Andy Pope's "PicViewer" or Mr. JE
McGimpsey's "lookuppics" routine.
Regards,
Mike
--
Andy Pope, Microsoft MVP - Excel
http://www.andypope.info