Resize userform to fit image

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Resize userform to fit image

Post by YasserKhalil »

Hello everyone
In that link
http://vbnet.mvps.org/index.html?code/f ... zeform.htm
I tried to apply to VBA and here's my try
In UserForm1 module (commadbutton and commondialog)

Code: Select all

Private Sub UserForm_Initialize()

   CommandButton1.Caption = "Load Image..."

End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

   Unload UserForm2

End Sub


Private Sub CommandButton1_Click()

   With CommonDialog1

      .Filter = "Image Files (gif, jpg, bmp, png)|*.gif;*.jpg;*.bmp;*.png|"
      .FilterIndex = 0
      .InitDir = "C:\"  'change as required
      .ShowOpen
      
      If Len(.filename) > 0 Then
      
         Load UserForm2
         UserForm2.Image1.Picture = LoadPicture(.filename)
         UserForm2.Caption = .filename
         UserForm2.Show

      End If

   End With

End Sub

And In UserForm2, image control inserted

Code: Select all

Private Declare Function GetSystemMetrics Lib "user32" _
   (ByVal nIndex As Long) As Long

Private Declare Function GetMenu Lib "user32" _
   (ByVal hwnd As Long) As Long

Private Const SM_CYCAPTION = 4
Private Const SM_CYMENU = 15
Private Const SM_CXFRAME = 32
Private Const SM_CYFRAME = 33

Private twipsx As Long
Private twipsy As Long

 
Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

End Sub


Private Sub UserForm_Initialize()
'Dim screen
'   twipsx = screen.TwipsPerPixelX
'   twipsy = screen.TwipsPerPixelY
   
   With Image1
      .AutoSize = True
      '.Appearance = 0
      '.Appearance = 0
      .BackColor = &HFFFF80
      .BorderStyle = 0
   End With
   Call AutoSizeToPicture(Image1)
End Sub


'Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'
'   Image1.AutoSize = True
'   Call AutoSizeToPicture(Image1)
'
'End Sub

''As PictureBox
Private Sub AutoSizeToPicture(pbox)

   Dim vOffset As Long
   Dim hOffset As Long
                     
   hOffset = (GetSystemMetrics(SM_CXFRAME) * 2) * twipsx
   vOffset = (GetSystemMetrics(SM_CYCAPTION) + (GetSystemMetrics(SM_CXFRAME)) * 2) * twipsx
                        
  'if the form also has a menu,
  'account for that too.
  '
  'NOTE: If you are just hiding the menu, then
  'GetMenu(Me.hwnd) will return non-zero even
  'if the menu is hidden, causing an incorrect
  'vertical offset to be used.  Either delete
  'the menu using the menu editor, or if you
  'must have the ability to show/hide a menu
  'on the picture form, you will need to code
  'to also test for me.mnuX.visible then...
  '
  'You can determine whether the correct sizing
  'is taking place by viewing the values returned
  'to the immediate window from the debug.print
  'code below; the values for the form and
  'picture should be the same, e.g.
  ' picture        3450          2385
  ' form           3450          2385

   If GetMenu(Application.hwnd) <> 0 Then
      vOffset = vOffset + (GetSystemMetrics(SM_CYMENU) * twipsy)
   End If

  'position the picture box and resize the form
   With pbox
      .Left = 0
      .Top = 0
      
      Me.Width = .Width + hOffset
      Me.Height = .Height + vOffset
   End With
   
  'these values should be the same
  'if the calculations worked
   Debug.Print "Image", Image1.Width, Image1.Height
   Debug.Print "Form", UserForm2.Width, UserForm2.Height

End Sub

There are no errors but the code doesn't work as expected. How can I resize the userform to fit the image?

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Resize userform to fit image

Post by YasserKhalil »

Any help in this topic please.

User avatar
HansV
Administrator
Posts: 78234
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Resize userform to fit image

Post by HansV »

No idea, sorry.
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Resize userform to fit image

Post by YasserKhalil »

Thanks a lot my tutor.
I've posted here too
https://www.mrexcel.com/board/threads/r ... e.1146541/

CData
3StarLounger
Posts: 308
Joined: 24 Dec 2015, 16:41

Re: Resize userform to fit image

Post by CData »

I can't tell if this is Access or not. If it is Access then determine the exact height and width you want the form to be. Then, in the
forms Open event, size it appropriately:

Private Sub Form_Open

me.insideheight = 4.25 * 1440
me.insidewidth = 6.0 * 1440

End sub