Option Explicit Private TopValue As Long Private LeftValue As Long Private WidthValue As Long Private HeightValue As Long Private WithEvents Image As MSForms.Image Private WithEvents Form As MSForms.UserForm Private MouseHoverValue As Boolean Property Let Top(Value As Long) TopValue = Value Image.Top = Value End Property Property Get Top() As Long Top = TopValue End Property Property Let Left(Value As Long) LeftValue = Value Image.Left = Value End Property Property Get Left() As Long Left = LeftValue End Property Property Let Width(Value As Long) WidthValue = Value Image.Width = Value End Property Property Get Width() As Long Width = WidthValue End Property Property Let Height(Value As Long) HeightValue = Value Image.Height = Value End Property Property Let Picture(Value As StdPicture) Image.Picture = Value End Property Property Get Picture() As StdPicture Set Picture = Image.Picture End Property Property Let MouseHover(Value As Boolean) MouseHoverValue = Value End Property Property Get MouseHover() As Boolean MouseHover = MouseHoverValue End Property Public Sub SetImageCtrl(ImageCtrl As MSForms.Image, Picture As StdPicture) Set Image = ImageCtrl Set Form = ImageCtrl.Parent Me.Picture = Picture TopValue = Image.Top LeftValue = Image.Left WidthValue = Image.Width HeightValue = Image.Height MouseHover = False End Sub Private Sub Form_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Not Application.Ready Then Exit Sub Application.EnableEvents = False If MouseHover Then Call ScaleTransform Application.EnableEvents = True End Sub Private Sub Image_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Not Application.Ready Then Exit Sub Application.EnableEvents = False If Not MouseHover Then Call ScaleTransform Application.EnableEvents = True End Sub Public Sub ScaleTransform() If Not Application.Ready Then Exit Sub Dim TransStart As Long Dim TransEnd As Long Dim TransStep As Long TransStart = IIf(MouseHover, 5, 1) TransEnd = IIf(MouseHover, 0, 6) TransStep = IIf(MouseHover, -1, 1) MouseHover = Not MouseHover Dim i As Long For i = TransStart To TransEnd Step TransStep Dim Dx As Single Dim Dy As Single Dx = WidthValue * 0.05 * i Dy = HeightValue * 0.05 * i Image.Width = WidthValue + Dx Image.Height = HeightValue + Dy Image.Left = LeftValue - Dx / 2 Image.Top = TopValue - Dy / 2 Call Application.Wait([Now()] + 20 / 86400000) Next End Sub