zoom image-picture in excel VBA
this video allows you to design zoom image/picture in user form.
---------------------------------source code: -------------------------------------
Private Sub CommandButton5_Click()
Dim strPic As String
With Application.FileDialog(1) ' msoFileDialogOpen
.Filters.Clear
. Filters. Add "Image Files (*.jpg, *.bmp, *.gif, *.jfif,*.jpeg)", "*.jpg, *.gif, *, *.jfif,*jpeg"
If. Show Then
Me. Image1. Picture = Nothing
strPic = .SelectedItems(1)
Me. Image1. Picture = LoadPicture(strPic)
TextBox1.Text = strPic
Else
Beep
End If
End With
End Sub
Sub ZoomImage(ByVal ZoomFactor As Double, ByVal Steps As Integer, ByVal Interval As Double)
Dim i As Integer
Dim OriginalWidth As Single, OriginalHeight As Single
Dim NewWidth As Single, NewHeight As Single
' Store the original dimensions of the Image control
OriginalWidth = UserForm1.Image1.Width
OriginalHeight = UserForm1.Image1.Height
For i = 1 To Steps
' Calculate the new dimensions
NewWidth = OriginalWidth * (1 + (ZoomFactor * i) / Steps)
NewHeight = OriginalHeight * (1 + (ZoomFactor * i) / Steps)
' Apply the new dimensions
With UserForm1.Image1
.Width = NewWidth
.Height = NewHeight
End With
' Adjust the scrollable area of the Frame
With UserForm1.Frame1
.ScrollWidth = NewWidth
.ScrollHeight = NewHeight
End With
' Optional: Pause between steps for gradual effect
Application.Wait Now + Interval / 86400 ' Interval in seconds
Next i
End Sub
Sub ZoomOutImage(ByVal ZoomFactor As Double, ByVal Steps As Integer, ByVal Interval As Double)
Dim i As Integer
Dim OriginalWidth As Single, OriginalHeight As Single
Dim NewWidth As Single, NewHeight As Single
' Store the original dimensions of the Image control
OriginalWidth = UserForm1.Image1.Width
OriginalHeight = UserForm1.Image1.Height
For i = 1 To Steps
' Calculate the new dimensions (decrease size)
NewWidth = OriginalWidth * (1 - (ZoomFactor * i) / Steps)
NewHeight = OriginalHeight * (1 - (ZoomFactor * i) / Steps)
' Ensure dimensions do not shrink below a minimum threshold
If NewWidth (use angle bracket) 50 Or NewHeight (use angle bracket) 50 Then Exit For
' Apply the new dimensions
With UserForm1.Image1
.Width = NewWidth
.Height = NewHeight
End With
' Adjust the scrollable area of the Frame
With UserForm1.Frame1
.ScrollWidth = NewWidth
.ScrollHeight = NewHeight
End With
' Optional: Pause between steps for gradual effect
Application. Wait Now + Interval / 86400 ' Interval in seconds
Next i
End Sub
Private Sub CommandButtonZoomin_Click()
If TextBox1.Text = "" Then
MsgBox "Image not selected.", vbCritical, ""
Exit Sub
End If
' Zoom in the image by 20% over 10 steps, pausing 0.1 seconds between steps
Call ZoomImage(0.2, 10, 0.1)
End Sub
Private Sub CommandButtonZoomOut_Click()
If TextBox1.Text = "" Then
MsgBox "Image not selected.", vbCritical, ""
Exit Sub
End If
' Zoom out the image by 20% over 10 steps, pausing 0.1 seconds between steps
Call ZoomOutImage(0.2, 10, 0.1)
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
Application.Visible = True
End Sub