Fadi
Fadi

Reputation: 3322

How to make a userform very small

I could not make userform width less than 105 and height less than 29.25

I tried this:

Sub test()
 With UserForm1
  .Width = 10
  .Height = 10
  .Show vbModeless
 End With
End Sub

But it stay bigger than that:

Private Sub CommandButton1_Click()
 MsgBox "Width=" & Me.Width & ", Height=" & Me.Height
 Unload Me
End Sub

Now the MsgBox show : Width=102.3, Height=26.95 and when i asked this question it was Width=105, Height=29.25 (I'm using another monitor now). It seems that excel don't accept very small userform

So my question is: How to make my userform very small (to fit in one excel cell for example)

Note: I use remove caption in my form, I get remove caption from this link: Remove Caption From User Form

Upvotes: 1

Views: 2006

Answers (1)

Patrick Lepelletier
Patrick Lepelletier

Reputation: 1654

you canot make the userform this small, but you can fake it:

(1) First create a Frame that simuls the Userform, make it as small as wanted. (2) Then you make the Userform transparent & 'Clic-Through-able'

Code to support this (2) , in 64 bit (modifications are easier for going back to 32 bit than reverse, and i guess nowadays everyone should have a 64 bit system)

In a Separate Module :

Option Explicit

Private Declare PtrSafe Function GetWindowLong Lib "user32" _
                     Alias "GetWindowLongA" _
                    (ByVal hWnd As LongPtr, _
                     ByVal nIndex As Long) As LongPtr

Private Declare PtrSafe Function SetWindowLong Lib "user32" _
                     Alias "SetWindowLongA" _
                    (ByVal hWnd As LongPtr, _
                     ByVal nIndex As Long, _
                     ByVal dwNewLong As LongPtr) As LongPtr

Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" ( _
ByVal hWnd As LongPtr, _
ByVal crey As Byte, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As LongPtr

Private Const GWL_EXSTYLE       As Long = (-20)
Private Const LWA_COLORKEY      As Long = &H1
Private Const LWA_ALPHA         As Long = &H2 'H2
Private Const WS_EX_LAYERED     As Long = &H80000

Public Declare PtrSafe Function FindWindowA Lib "user32" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'
'
'   *- TRANSPARENCE : SUPPR COULEUR / FORM ALPHA (auteur inconnu) -*
'   =============================================================
Public Function WndSetOpacity(ByVal hWnd As LongPtr, Optional ByVal crKey As Long = vbBlack, Optional ByVal Alpha As Byte = 255, Optional ByVal ByAlpha As Boolean = True) As Boolean
' Return : True si il n'y a pas eu d'erreur.
' hWnd   : hWnd de la fenêtre à rendre transparente
' crKey  : Couleur à rendre transparente si ByAlpha=False (utiliser soit les constantes vb:vbWhite ou en hexa:&HFFFFFF)
' Alpha  : 0-255 0=transparent 255=Opaque si ByAlpha=true (défaut)
On Error GoTo Lbl_Exit

Dim ExStyle As LongPtr
ExStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
If ExStyle <> (ExStyle Or WS_EX_LAYERED) Then
    ExStyle = (ExStyle Or WS_EX_LAYERED)
    Call SetWindowLong(hWnd, GWL_EXSTYLE, ExStyle)
End If
WndSetOpacity = (SetLayeredWindowAttributes(hWnd, crKey, Alpha,     IIf(ByAlpha, LWA_COLORKEY Or LWA_ALPHA, LWA_COLORKEY)) <> 0)

Lbl_Exit:
On Error GoTo 0
If Not Err.Number = 0 Then Err.Clear
End Function

Public Sub UserformTransparent(ByRef uf As Object, TransparenceControls As Integer)
'uf as MSForms.UserForm won't work !!!!
Dim B As Boolean
Dim lHwnd As LongPtr
On Error GoTo 0
'- Recherche du handle de la fenêtre par son Caption
lHwnd = FindWindowA(vbNullString, uf.Caption)
If lHwnd = 0 Then
    MsgBox "Handle de " & uf.Caption & " Introuvable", vbCritical
    Exit Sub
End If
'If d And F Then
    B = WndSetOpacity(lHwnd, uf.BackColor, TransparenceControls, True)
'ElseIf d Then
'    'B = WndSetOpacity(M.hwnd, , 255, True)
'    B = WndSetOpacity(lHwnd, , TransparenceControls, True)
'Else
'    B = WndSetOpacity(lHwnd, , 255, True)
'End If
End Sub


Public Sub ActiveTransparence(stCaption As String, d As Boolean, F As Boolean, Couleur As Long, Transparence As Integer)
Dim B As Boolean
Dim lHwnd As Long
'- Recherche du handle de la fenêtre par son Caption
lHwnd = FindWindowA(vbNullString, stCaption)
If lHwnd = 0 Then
    MsgBox "Handle de " & stCaption & " Introuvable", vbCritical
    Exit Sub
End If
If d And F Then
    B = WndSetOpacity(lHwnd, Couleur, Transparence, True)
ElseIf d Then
    'B = WndSetOpacity(M.hwnd, , 255, True)
    B = WndSetOpacity(lHwnd, , Transparence, True)
Else
    B = WndSetOpacity(lHwnd, , 255, True)
End If
End Sub

Note : The Two Subs UserFormTransparent, and ActiveTransparence are quite the same if you set D anf f to True.

Couleurmust be the color of your Userform's Background (no picture) , i sometimes had difficulties if this is not black (=0).

To call the Subs from inside the Userform_Initialize : UserformTransparent Me, 255 , the 255 is the max opacity of your controls and i don't advise going under 50 (invisible).

If you need Fake TitleBar to move the Form , you need no Api's, just add a label and 2 events to it : _mousemove and _mousedown , 2 variables X & Y common to the form, and voilà !

Upvotes: 2

Related Questions