locked
UserForm without titlebar and borders RRS feed

  • Question

  • Can't found working solution vba/api for Excel 32/64 2010

    Just needs, that userform have no any borders, no titlebar. Mb any can help?

    Tuesday, September 17, 2013 8:07 PM

Answers

  • Hi,

    I think you can achieve your goal by the module as followed.
    Code in Form:

    Private Sub UserForm_Initialize()     
        Call RemoveTitleBar(Me)     
    End Sub

    Code in Module:

    Option Explicit
    
    Private Declare Function FindWindow Lib "User32" _
    Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
    
    Private Declare Function GetWindowLong Lib "User32" _
    Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long) As Long
    
    Private Declare Function SetWindowLong Lib "User32" _
    Alias "SetWindowLongA" (ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
    
    Private Declare Function DrawMenuBar Lib "User32" ( _
    ByVal hwnd As Long) As Long
    
    Sub RemoveTitleBar(frm As Object)
        Dim lStyle          As Long
        Dim hMenu           As Long
        Dim mhWndForm       As Long
         
        If Val(Application.Version) < 9 Then
            mhWndForm = FindWindow("ThunderXFrame", frm.Caption) 'for Office 97 version
        Else
            mhWndForm = FindWindow("ThunderDFrame", frm.Caption) 'for office 2000 or above
        End If
        lStyle = GetWindowLong(mhWndForm, -16)
        lStyle = lStyle And Not &HC00000
        SetWindowLong mhWndForm, -16, lStyle
        DrawMenuBar mhWndForm
    End Sub
    
    Sub ShowForm()
        UserForm.Show False
    End Sub


    <THE CONTENT IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, WHETHER EXPRESS OR IMPLIED>
    Thanks
    MSDN Community Support

    Please remember to "Mark as Answer" the responses that resolved your issue. It is a common way to recognize those who have helped you, and makes it easier for other visitors to find the resolution later.

    • Marked as answer by Aramera Thursday, September 19, 2013 12:49 PM
    Thursday, September 19, 2013 8:47 AM

All replies

  • Hi,

    I think you can achieve your goal by the module as followed.
    Code in Form:

    Private Sub UserForm_Initialize()     
        Call RemoveTitleBar(Me)     
    End Sub

    Code in Module:

    Option Explicit
    
    Private Declare Function FindWindow Lib "User32" _
    Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
    
    Private Declare Function GetWindowLong Lib "User32" _
    Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long) As Long
    
    Private Declare Function SetWindowLong Lib "User32" _
    Alias "SetWindowLongA" (ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
    
    Private Declare Function DrawMenuBar Lib "User32" ( _
    ByVal hwnd As Long) As Long
    
    Sub RemoveTitleBar(frm As Object)
        Dim lStyle          As Long
        Dim hMenu           As Long
        Dim mhWndForm       As Long
         
        If Val(Application.Version) < 9 Then
            mhWndForm = FindWindow("ThunderXFrame", frm.Caption) 'for Office 97 version
        Else
            mhWndForm = FindWindow("ThunderDFrame", frm.Caption) 'for office 2000 or above
        End If
        lStyle = GetWindowLong(mhWndForm, -16)
        lStyle = lStyle And Not &HC00000
        SetWindowLong mhWndForm, -16, lStyle
        DrawMenuBar mhWndForm
    End Sub
    
    Sub ShowForm()
        UserForm.Show False
    End Sub


    <THE CONTENT IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, WHETHER EXPRESS OR IMPLIED>
    Thanks
    MSDN Community Support

    Please remember to "Mark as Answer" the responses that resolved your issue. It is a common way to recognize those who have helped you, and makes it easier for other visitors to find the resolution later.

    • Marked as answer by Aramera Thursday, September 19, 2013 12:49 PM
    Thursday, September 19, 2013 8:47 AM
  • Luna - many thx!

    Since I posted that, found this http://answers.microsoft.com/ru-ru/office/forum/office_2010-excel/как/c0b5696d-e043-e011-9767-d8d385dcbb12?msgId=66ae175b-0344-e011-9767-d8d385dcbb12

    Right vba will be

    Option Explicit
    
    Public Initializeted_InfoForm1 As Boolean
    
    Sub ggg()
        On Error Resume Next
        InfoForm1.Show
    End Sub


    and in form

    Option Explicit
    
    Private Const AW_OPTIMAL_TIME = 500& 'Âðåìÿ àíèìàöèè
    Private Const AW_HOR_POSITIVE = &H1 'Ðàçâåðòûâàíèå ñëåâà íàïðàâî
    Private Const AW_HOR_NEGATIVE = &H2 'Ðàçâåðòûâàíèå ñïðàâà íàëåâî
    Private Const AW_VER_POSITIVE = &H4 'Ðàçâåðòûâàíèå ñâåðõó âíèç
    Private Const AW_VER_NEGATIVE = &H8 'Ðàçâåðòûâàíèå ñíèçó ââåðõ
    Private Const AW_CENTER = &H10      'Ðàçâåðòûâàíèå èç öåíòðà
    Private Const AW_HIDE = &H10000     'Ñêðûòü îêíî; Åñëè ýòîò ôëàã îòñóòñòâóåò - Ïîêàçàòü
    Private Const AW_ACTIVATE = &H20000 'Àêòèâèçèðîâàòü îêíî
    Private Const AW_SLIDE = &H40000    'Ñêîëüæåíèå
    Private Const AW_BLEND = &H80000    'Çàòåìíåíèå
    Private Const GWL_STYLE As Long = (-16)
    Private Const GWL_EXSTYLE = (-20)
    Private Const WS_CAPTION As Long = &HC00000
    Private Const WS_BORDER As Long = &H800000
    Private Const WS_EX_LAYERED = &H80000
    Private Const SWP_NOACTIVATE = &H10
    Private Const SWP_NOSIZE = &H1
    Private Const SWP_NOMOVE = &H2
    Private Const SWP_SHOWWINDOW = &H40
    Private Const SWP_FRAMECHANGED = &H20
    Private Const SWP_NOOWNERZORDER = &H200
    Private Const SWP_NOZORDER = &H4
    Private Const LWA_COLORKEY = &H1
    Private Const LWA_ALPHA = &H2
    Private Const WM_NCLBUTTONDOWN = &HA1
    Private Const HTCAPTION = 2
    Private Type POINTAPI
        x As Long
        y As Long
    End Type
    
    #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
            Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        #Else
            Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
            Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
        Private Declare PtrSafe Function AnimateWindow Lib "user32" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Boolean
        Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
        Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
        Private Declare PtrSafe Sub ReleaseCapture Lib "user32" ()
        Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
       
    #Else
    
        Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
        Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
        Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
       
        Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Boolean
        Private Declare Function GetCursorPos& Lib "user32.dll" (lpPoint As POINTAPI)
        Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
        Private Declare Sub ReleaseCapture Lib "user32" ()
        Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    
    #End If
    
    '***********************************
    Private ihWnd As Long
    '***********************************
    
    #If VBA7 Then
        Private Sub MoveFormOnScreen(Optional ByVal ToCursor As Boolean = False)
            Dim I As Long, j As Long, Coord As POINTAPI
            I = GetWindowLongPtr(ihWnd, GWL_STYLE)
            I = I And Not WS_CAPTION And Not WS_BORDER
            j = SetWindowLongPtr(ihWnd, GWL_STYLE, I)
            j = SetWindowLongPtr(ihWnd, GWL_EXSTYLE, 0)
            If ToCursor Then
                GetCursorPos Coord
                SetWindowPos ihWnd, 0, Coord.x, Coord.y, 0, 0, SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
            Else
                I = Application.ActiveWindow.Height: j = Application.ActiveWindow.Width
                I = Int(I / 2 + 50)
                j = Int(j / 2)
                SetWindowPos ihWnd, 0, j, I, 0, 0, SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
            End If
        End Sub
       
        Private Sub SetTransparent(Optional ByVal Layered As Byte = 255)
            Dim Ret As Long
            Ret = GetWindowLongPtr(ihWnd, GWL_EXSTYLE)
            Ret = Ret Or WS_EX_LAYERED
            SetWindowLongPtr ihWnd, GWL_EXSTYLE, Ret
            SetLayeredWindowAttributes ihWnd, 0, Layered, LWA_ALPHA
        End Sub
       
    #Else
        Private Sub MoveFormOnScreen(Optional ByVal ToCursor As Boolean = False)
            Dim I As Long, j As Long, Coord As POINTAPI
            I = GetWindowLong(ihWnd, GWL_STYLE)
            I = I And Not WS_CAPTION And Not WS_BORDER
            j = SetWindowLong(ihWnd, GWL_STYLE, I)
            j = SetWindowLong(ihWnd, GWL_EXSTYLE, 0)
            If ToCursor Then
                GetCursorPos Coord
                SetWindowPos ihWnd, 0, Coord.x, Coord.y, 0, 0, SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
            Else
                I = Application.ActiveWindow.Height: j = Application.ActiveWindow.Width
                I = Int(I / 2 + 50)
                j = Int(j / 2)
                SetWindowPos ihWnd, 0, j, I, 0, 0, SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
            End If
        End Sub
       
        Private Sub SetTransparent(Optional ByVal Layered As Byte = 255)
            Dim Ret As Long
            Ret = GetWindowLong(ihWnd, GWL_EXSTYLE)
            Ret = Ret Or WS_EX_LAYERED
            SetWindowLong ihWnd, GWL_EXSTYLE, Ret
            SetLayeredWindowAttributes ihWnd, 0, Layered, LWA_ALPHA
        End Sub
       
    #End If
    
    Public Sub MoveIt()
        Call ReleaseCapture
        SendMessage ihWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
    End Sub
    
    '***********************************
    
    Private Sub UserForm_Initialize()
        If Initializeted_InfoForm1 Then Exit Sub ' Ãëîáàëüíàÿ ïåðåìåííàÿ.
        ihWnd = FindWindow(vbNullString, Me.Caption)
        MoveFormOnScreen
        SetTransparent 180
        AnimateWindow ihWnd, AW_OPTIMAL_TIME, AW_HOR_POSITIVE
        Initializeted_InfoForm1 = True ' Ãëîáàëüíàÿ ïåðåìåííàÿ - ôîðìà óæå àêòèâèðîâàíà.
        'MyLoadForm ' Ýòî ïîëüçîâàòåëüñêàÿ ïðîöåäóðà âìåñòî UserForm_Load èëè âìåñòî UserForm_Activate
    End Sub
    
    Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
        AnimateWindow ihWnd, AW_OPTIMAL_TIME, AW_HIDE Or AW_HOR_NEGATIVE
        Initializeted_InfoForm1 = False
    End Sub
    
    Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        If KeyCode = 27 Then Unload InfoForm1
    End Sub
    Private Sub UserForm_Click()
        Unload Me
    End Sub
    Private Sub UserForm_Deactivate()
        Unload Me
    End Sub
    
    '***********************************

    So, question. Your vba perfectly works. The above one (pasted by me) doesent works as properly if I use "ThisWorkbook.IsAddin = True" on open. All sheets veryHiddeen. Then autorization form (Userform_Activate also used...). If ok - ""ThisWorkbook.IsAddin = False" and all sheets (which current user can see) - displays.

    Its possible some expand your vba to: transarency, animation,and moving on screen? My vba knowledge is not enough for that, just for reading, uderstating and some correction.

    All i needs, that before autorization no one sheet were displayed. And were good - if form will be animated :)

    Excuse my ugly English)


    • Edited by Aramera Thursday, September 19, 2013 1:17 PM
    Thursday, September 19, 2013 1:15 PM
  • Can't found working solution vba/api for Excel 32/64 2010

    Just needs, that userform have no any borders, no titlebar. Mb any can help?

    good, it works

    I'm making a tranparent vertical form only with buttons to excel 97, a vertical menu bar

    Mário Frank

    Monday, January 23, 2017 3:44 PM