Userform transparent machen und Kopf und Rahmen entfernen

[volti]

Hallo Forum,

kann man eine Userform auch transparent machen?

Ja, das kann man ganz einfach bewerkstelligen.
Indem man den Style der Userform auf WS_EX_LAYERED stellt und eine Farbe zuweist, deren Pixel dann transparent dargestellt werden.

Hier mal ein ganz einfacher, stark reduzierter Code als Beispiel.
Bitte beachten, dass der Hintergrund der Userform mit einer Farbe aus der Palette versehen wird und keine Systemfarbe verwendet wird.

Code:

Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
#If Win64 Then
 Private Declare PtrSafe Function SetWindowLongA Lib "user32" Alias "SetWindowLongPtrA" ( _
         ByVal hWnd As LongPtr, ByVal nIndex As Long, _
         ByVal dwNewLong As LongPtr) As LongPtr
 Private Declare PtrSafe Function GetWindowLongA Lib "user32" Alias "GetWindowLongPtrA" ( _
         ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
#Else
 Private Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hWnd As LongPtr, _
         ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
 Private Declare PtrSafe Function GetWindowLongA Lib "user32" ( _
         ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
#End If
Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" ( _
        ByVal hWnd As LongPtr, ByVal crKey As Long, ByVal bAlpha As Long, _
        ByVal dwFlags As Long) As Long

Private Sub UserForm_Activate()
' GWL_EXSTYLE = (-20&), WS_EX_LAYERED = &H80000, LWA_COLORKEY  = &H1
  SetWindowLongA GetActiveWindow, -20, _
  GetWindowLongA(GetActiveWindow, -20) Or &H80000
  SetLayeredWindowAttributes GetActiveWindow, BackColor, 0, 1
End Sub

Wer zusätzlich noch den Kopf und den Rahmen entfernen möchte, muss noch etwas mehr Aufwand betreiben.
Hier ein Beispiel, bei dem nur noch ein Textfeld und eine Schaltfläche sichtbar sind.
Die Userform wird zusätzlich noch an die gerade aktive Excelzelle platziert. So könnte man alle möglichen Spezialanwendungen programmieren.


  Userform_TransparenteUserform.xlsb (Größe: 52,4 KB / Downloads: 4)

Code:

Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
#If Win64 Then
 Private Declare PtrSafe Function SetWindowLongA Lib "user32" Alias "SetWindowLongPtrA" ( _
         ByVal hWnd As LongPtr, ByVal nIndex As Long, _
         ByVal dwNewLong As LongPtr) As LongPtr
 Private Declare PtrSafe Function GetWindowLongA Lib "user32" Alias "GetWindowLongPtrA" ( _
         ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
#Else
 Private Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hWnd As LongPtr, _
         ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
 Private Declare PtrSafe Function GetWindowLongA Lib "user32" ( _
         ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
#End If
Private Declare PtrSafe Function SetWindowPos Lib "user32" ( _
        ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _
        ByVal x As Long, ByVal y As Long, _
        ByVal cx As Long, ByVal cy As Long, _
        ByVal wFlags As Long) As Long
Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" ( _
        ByVal hWnd As LongPtr, ByVal crKey As Long, ByVal bAlpha As Long, _
        ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function SetWindowRgn Lib "user32" ( _
        ByVal hWnd As LongPtr, ByVal hRgn As LongPtr, ByVal bRedraw As Long) As Long
Private Declare PtrSafe Function CreateRoundRectRgn Lib "gdi32" ( _
        ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, _
        ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As LongPtr
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function CreateRectRgnIndirect Lib "gdi32" (lpRect As RECT) As LongPtr
Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _
        ByVal hWnd As LongPtr, lpRect As RECT) As Long
Private Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type


Private Sub UserForm_Activate()
  Dim R As RECT, oCell As Range
  Dim hRegion As LongPtr, hWndUF As LongPtr
  Const GWL_EXSTYLE   As Long = (-20&)
  Const GWL_STYLE     As Long = (-16)
  Const WS_EX_LAYERED As Long = &H80000
  Const LWA_COLORKEY  As Long = &H1
  Const WS_CAPTION    As Long = &HC00000
  
  hWndUF = GetActiveWindow                      ' Userform: Handle holen
  SetWindowLongA hWndUF, GWL_STYLE, GetWindowLongA(hWndUF, GWL_STYLE) And Not WS_CAPTION
  SetWindowLongA hWndUF, GWL_EXSTYLE, GetWindowLongA(hWndUF, GWL_EXSTYLE) Or WS_EX_LAYERED
  SetLayeredWindowAttributes hWndUF, Me.BackColor, 0&, LWA_COLORKEY
  DrawMenuBar hWndUF                            ' Userform neu zeichnen
  
  GetWindowRect hWndUF, R                       ' Userform: Koordinaten holen
  R.Bottom = R.Bottom - R.Top - 8:  R.Top = 4   ' Bereich zurecht
  R.Right = R.Right - R.Left - 8:   R.Left = 4  ' schneiden
  hRegion = CreateRectRgnIndirect(R)            ' Eine Region erstellen
  SetWindowRgn hWndUF, hRegion, 1&              ' Region scharf schalten
  DeleteObject hRegion                          ' Region löschen
  
  Set oCell = ActiveCell                        ' Bindezelle setzen
  With ActiveWindow.ActivePane
       SetWindowPos hWndUF, 0&, _
                    .PointsToScreenPixelsX(oCell.Left - 3), _
                    .PointsToScreenPixelsY(oCell.Top - 3), _
                    0&, 0&, &H1 ' &H1 = SWP_NOSIZE
  End With

  Me.TextBox1.Value = ActiveCell.Value
End Sub

_________
viele Grüße
Karl-Heinz