Zoom Picture Frame In Userform VBA EXCEL 2021

Zoom Picture Frame In Userform VBA EXCEL, là khái niệm để chỉ việc xem (view) với kích thước lớn hơn bằng công cụ hỗ trợ. Có nghĩa là kích thước thực tế của hình ảnh không thay đổi.

Tuy nhiên, bạn sẽ được xem hình ảnh hiển thị của bức hình ở kích thước lớn hơn. Việc này tương tự với việc bạn tiến đến gần hơn với hình ảnh để xem chi tiết. Hoặc nó giống với việc bạn sử dụng kính lúp, hoặc kính hiển vi xem một đối tượng bất kì. Về mặt bản chất, kích thước của vật không hề thay đổi, chúng ta chỉ thay đổi cách nhìn đối với nó mà thôi.

Zoom Picture Frame In Userform VBA EXCEL 2021

I.CÁCH THỨC HOẠT ĐỘNG

Sự kiện UserForm_Activate để kích hoạt, khi bạn mở lên nó sẽ loading hình ảnh cho userform cảm thấy mượt mà hơn.

Sự kiện Image1_MouseDown, khi bạn di chuyển chuột đồng thời đè gim thì Frame1 cũng di chuyển theo vị trí con trỏ chuột của bạn tạo, để tạo hiệu ứng động.

Sự kiện Image1_MouseMove, khi bạn di chuyển con chuôt, đồng thời nó sẽ tính toán kích thước tấm hình, và truyền qua IMAGE2 trong Frame1.

Sự kiện: Image1_MouseUp, khi bạn thả chuột đồng thời Frame1 cũng ẩn đi.

Sự kiện Image1_Click(), Các Application.ScreenUpdating, Image1.Visible ẩn hình ảnh đi và bật lại tạo hiểu ứng hình ảnh không bị đơ.

II.CODE

Option Explicit
Private m_ZoomFactor As Double
Private Sub CheckBox1_Click()
    If CheckBox1.Value Then
        Image2.AutoSize = False
        Image2.PictureSizeMode = fmPictureSizeModeStretch
        Image2.Width = Image2.Width * 2
        Image2.Height = Image2.Height
    Else
        Image2.PictureSizeMode = fmPictureSizeModeClip
        Image2.AutoSize = True
    End If
End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub
Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then
        With Frame1
            .Left = X
            .Top = Y
            .Visible = True
        End With
    End If
End Sub

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim RatioX As Double
    Dim RatioY As Double
    If Button = 1 Then
        Frame1.Left = Image1.Left + X - (Frame1.Width / 2)
        Frame1.Top = Image1.Top + Y - (Frame1.Height / 2)
        RatioX = X / Image1.Width
        RatioY = Y / Image1.Height
        Image2.Left = -(Image2.Width * RatioX) + (Frame1.Width / 2)
        Image2.Top = -(Image2.Height * RatioY) + (Frame1.Height / 2)
    End If
End Sub
Private Sub Image1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then
        Frame1.Left = Image1.Left + Image1.Width
        Frame1.Top = Image1.Top + Image1.Height
        Frame1.Left = -500
        Frame1.Visible = False
    End If
End Sub

Private Sub Image3_Click()
Application.ScreenUpdating = False
Image1.Visible = False
Image1.Picture = Image3.Picture
Image2.Picture = Image1.Picture
Call CAPNhap
Image1.Visible = True
Application.ScreenUpdating = True
End Sub

Private Sub Image4_Click()
Application.ScreenUpdating = False
Image1.Visible = False
Image1.Picture = Image4.Picture
Image2.Picture = Image1.Picture
Call CAPNhap
Image1.Visible = True
Application.ScreenUpdating = True
End Sub

Private Sub Image5_Click()
Application.ScreenUpdating = False
Image1.Visible = False
Image1.Picture = Image5.Picture
Image2.Picture = Image1.Picture
Call CAPNhap
Image1.Visible = True
Application.ScreenUpdating = True
End Sub

Private Sub Image6_Click()
Application.ScreenUpdating = False
Image1.Visible = False
Image1.Picture = Image6.Picture
Image2.Picture = Image1.Picture
Call CAPNhap
Image1.Visible = True
Application.ScreenUpdating = True
End Sub

Private Sub Image7_Click()
Application.ScreenUpdating = False
Image1.Visible = False
Image1.Picture = Image7.Picture
Image2.Picture = Image1.Picture
Call CAPNhap
Image1.Visible = True
Application.ScreenUpdating = True
End Sub

Private Sub Image8_Click()
Application.ScreenUpdating = False
Image1.Visible = False
Image1.Picture = Image8.Picture
Image2.Picture = Image1.Picture
Call CAPNhap
Image1.Visible = True
Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Activate()
Call CAPNhap
End Sub

Private Sub ZoomFactor_Change()
    m_ZoomFactor = CDbl(ZoomFactor.Value)
    Image2.AutoSize = True
    If ZoomFactor.ListIndex > 0 Then
        Image2.AutoSize = False
        Image2.PictureSizeMode = fmPictureSizeModeStretch
        Image2.Width = Image2.Width * m_ZoomFactor
        Image2.Height = Image2.Height * m_ZoomFactor
    Else
        Image2.PictureSizeMode = fmPictureSizeModeClip
    End If
End Sub

Sub CAPNhap()
    Image2.Picture = Image1.Picture
    Image2.AutoSize = True
    Frame1.SpecialEffect = fmSpecialEffectRaised
    Frame1.Visible = False
    m_ZoomFactor = 1
    ZoomFactor.List = Array ("1.0", "1.5", "2.0", "2.5", "3.0", "3.5", "4.0", "5.0", "10.0")
    ZoomFactor.ListIndex = 0
Kết thúc Sub

III.Down

DOWN DEMO TẠI ĐÂY

IV. Kết

Như vậy, chúng tôi đã chia sẻ đến các bạn cách tạo Zoom Picture Frame In Userform VBA EXCEL. Hy vọng, nó sẽ giúp các bạn phần nào trong quá trình học tập, cũng như nâng cao hiệu quả làm việc.

Tham khảo những bài viết khác.

Tìm kiếm dữ liệu trong listbox từ textbox

Chuyển đổi số thành chữ viết bằng Code VBA

Phần mềm xuất nhập tồn bằng Excel miễn phí 2021