Reputation: 3322
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
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
.
Couleur
must 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