Aplicar transparencia a formulario de Excel vba
Para este artículo les comparto un tip muy interesante, que seguramente les podrán encontrar un uso útil a sus proyectos y darles un Plus en la presentación.
Pues bien, el tip que les comparto es cómo aplicar transparencia a un formulario desarrollado en vba. Esto mediante la llamada a API’s de Windows.
Lo mejor, y para no hacerles el trabajo complicado, el código es compatible con Windows y Excel de 32 y 64 bits. Para más sobre el tema de compatibilidad visita Hacer macros compatibles con Excel de 32 y 64 bits.
Cómo funciona
El formulario del ejemplo es sencillo y tiene los siguientes controles:
- 1 CheckBox.
- 1 control Image.
- 1 CommandButton.
Al lanzar el formulario usaremos el método vbModeless en valor TRUE para que nos permita seguir utilizando las celdas de Excel sin necesidad de cerrar el formulario.
Figura 1. Formulario sin transparencia.
Mediante llamadas a API’s de Windows lograremos que al elegir el CheckBox con la leyenda “Habilitar transparencia” al formulario se le aplique una transparencia del 50% cuando el CheckBox esté en TRUE.
Figura 2. Formulario con transparencia.
Código vba del formulario
Ubicación: UserForm1
'Declaramos variables compatibles con 32 y 64 bits. '---------------------------------- #If VBA7 And Win64 Then Private Declare PtrSafe Function GetActiveWindow Lib "USER32" () As Long #Else Private Declare Function GetActiveWindow Lib "USER32" () As Long #End If '---------------------------------- #If VBA7 And Win64 Then #If VBA7 Then #If Win64 Then Private Declare PtrSafe Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongPtrA" _ (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr #Else Private Declare Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongA" _ (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr #End If #Else Private Declare Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long #End If #Else Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long #End If '---------------------------------- #If VBA7 And Win64 Then #If VBA7 Then #If Win64 Then Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" _ Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr #Else Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" _ Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr #End If #Else Private Declare Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long) As Long #End If #Else Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long) As Long #End If '---------------------------------- #If VBA7 And Win64 Then Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "USER32" ( _ ByVal hwnd As LongPtr, ByVal crKey As Integer, _ ByVal bAlpha As Integer, ByVal dwFlags As Long) As LongPtr #Else Private Declare Function SetLayeredWindowAttributes Lib "USER32" ( _ ByVal hwnd As Long, ByVal crKey As Integer, _ ByVal bAlpha As Integer, ByVal dwFlags As Long) As Long #End If '---------------------------------- Private Const WS_EX_LAYERED = &H80000 Private Const LWA_COLORKEY = &H1 Private Const LWA_ALPHA = &H2 Private Const GWL_EXSTYLE = &HFFEC Dim hwnd As Long Private Sub CheckBox1_Click() 'CheckBox para aplicar transparencia ' Select Case True ' Case CheckBox1.Value Call Semitransparent(50) Case Else Call Semitransparent(100) End Select ' End Sub ' Private Sub CommandButton1_Click() 'Cerrar formulario Unload Me End Sub Private Sub Semitransparent(ByVal intLevel As Integer) 'Aplicar transparencia #If VBA7 And Win64 Then Dim lngWinIdx As LongPtr #Else Dim lngWinIdx As Long #End If ' #If VBA7 And Win64 Then hwnd = GetActiveWindow lngWinIdx = GetWindowLongPtr(hwnd, GWL_EXSTYLE) SetWindowLongPtr hwnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED SetLayeredWindowAttributes hwnd, 0, (255 * intLevel) / 100, LWA_ALPHA #Else hwnd = GetActiveWindow lngWinIdx = GetWindowLong(hwnd, GWL_EXSTYLE) SetWindowLong hwnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED SetLayeredWindowAttributes hwnd, 0, (255 * intLevel) / 100, LWA_ALPHA #End If ' 'Label1.Caption = "Semitransparent level is ..." & (100 - intLevel) & "%" End Sub
:: Descargar el ejemplo Formulario transparente en Excel vba.rar