Adding Custom button in titlebar of userform

[xtream]

Hello Forum,

I need to add custom button in titlebar of userform.
You help will be extreamly appreicated.

Thanks in advance.

XTREAM...

[Bob Phillips]

Why, what is wrong with a button on the form?

[xtream]

It is required to add additional button with close button. When we click on this button it show simple message "Hello world". After some time I will place functionality according to client requirements.

[Bob Phillips]

That is just reiterating what you said before, it does nothing to tell me it is needed in the title bar and not as a button on the form.

[xtream]

Custom Button is needed to add in titlebar of USERFORM along with close button(x).

For time being if we press it then it show us "Hello world". This is what I want to do in USERFORM.

[Bob Phillips]

I give up, you just keep saying the same thing, and ignore my question.

Perhaps someone else will be able to help.

[xtream]

Hello Forum,

I need to add custom button in titlebar of userform.
It should come near to close (x) button.

When we click on this button it show message box "Hello world"
You help will be extreamly appreicated.

Thanks in advance.

XTREAM...

[mikerickson]

If you put this in the userform's code module, pressing the existing X in the corner will bring up the message box you want.

[VBA]Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then
MsgBox "Hello world"
End If
End Sub[/VBA]

[xtream]

Thanks Mike,

For your prompt reply.

Let me clear what I want


1. I need to place an extra button in title bar. Let say its caption is "test"
it is placed near with close button.

2. When I clicked on "test" button the its click event should be executed and show me the msgbox with "Hello World"

I have a complete application in VB 6.0 to do this work. But it is not working in Excel userform.

Please share you email address. I shall forward you the vb 6.0 code with same functionality.

I hope you have understand properly what I want.

Thanks in advance.

[Tinbendr]

You will probably need to use API, which is generally beyond the scope of this forum.

Google is your friend. But here is one reference.

[xtream]

Thanks Tinbendr for taking interest in this issue.

But the fact is that could not found any help properly to cope this issue. I have found some solution that are related with Max, Min button via api.

But could not see anything that is used for custimize button.

And also looking to resolve this issue.

[Tinbendr]

Maybe here?

[GTO]

Hi There,

Maybe this has to do with the users one is faced with, but adding custom buttons to the titlebar seems non-intuitive for the users. Shucks, least as I can see, the use of the close button (or the close button and the minimize and restore/maximize buttons) is one of the few things we can safely bet on the user not mucking up. Now we want to "un-train" the user? Again, maybe just the users I am used to, so onward...

Hopefully someone will take pity and point out how to do this if I am incorrect, but I see no way of actually creating an additional custom button in the titlebar of a userform with VBA and/or API.

I would note that as a concept it certainly seems possible, as I did find this in C# : http://www.codeproject.com/KB/cs/mintraybtn.aspx

Unfortunately, I do not understand the code to even know if the efforts are translatable.

If this is possible through VB6 as you indicated, maybe zip a text file with the code. Then maybe someone could see a way in VBA?

I did find a workaround in VB, that I was able to carry over to VBA. Quite frankly, this seems far too mucky to me to be worth it, but for what its worth:

In a Standard Module:

'//*****************************************************************************//
'// Using code adapted from Masaru Kaji (Colo) at:                              //
'// http://puremis.net/excel/code/024.shtml                                     //
'// and code for grabbing a label as a pseudo titlebar at:                      //
'// http://www.developerfusion.com/code/...stom-title-bar                   //
'//*****************************************************************************//
Option Explicit
 
Public Declare Function ReleaseCapture Lib "user32" () As Long
 
Public Declare Function SendMessage Lib "user32" _
                         Alias "SendMessageA" (ByVal hWnd As Long, _
                                               ByVal wMsg As Long, _
                                               ByVal wParam As Long, _
                                               ByRef lParam As Any _
                                               ) As Long
 
Public Declare Function SetWindowText Lib "user32" _
                         Alias "SetWindowTextA" (ByVal hWnd As Long, _
                                                 ByVal lpString As String _
                                                 ) As Long
 
Public Declare Function GetWindowLong Lib "user32" _
                        Alias "GetWindowLongA" (ByVal hWnd As Long, _
                                                ByVal nIndex As Long _
                                                ) As Long
 
Public Declare Function SetWindowLong Lib "user32" _
                        Alias "SetWindowLongA" (ByVal hWnd As Long, _
                                                ByVal nIndex As Long, _
                                                ByVal dwNewLong As Long _
                                                ) As Long
 
Public Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long _
                                                  ) As Long
 
Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, _
                                                  ByVal lpWindowName As String _
                                                  ) As Long
 
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const GWL_STYLE = -16
Public Const WS_CAPTION = &HC00000
 
Public Function TitleBar_Hide(UF As Object, lUFHandle As Long)
Dim lWindow As Long
 
    lUFHandle = FindWindowA(vbNullString, UF.Caption)
    lWindow = GetWindowLong(lUFHandle, GWL_STYLE)
    lWindow = lWindow And (Not WS_CAPTION)
    Call SetWindowLong(lUFHandle, GWL_STYLE, lWindow)
    Call DrawMenuBar(lUFHandle)
End Function

In a new UserForm, with two labels, three command buttons, and one image control, all named as indicated...

Userform Module:

Option Explicit
 
Dim hWnd As Long
 
Private Sub cmdCancel_Click()
    Unload Me
End Sub
 
Private Sub lblTitleBar_MouseDown(ByVal Button As Integer, _
                             ByVal Shift As Integer, _
                             ByVal X As Single, _
                             ByVal Y As Single)
    '// I have read exactly nothinig on ReleaseCapture and have very little true    //
    '// grasp on SendMessage, so this part is mostly like electricity to a five     //
    '// year old.  Its magic, it works, I cannot see how, but I know not to stick a //
    '// butter knife into a socket.                                                 //
    ReleaseCapture
    SendMessage hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub
 
Private Sub cmdClose_Click()
    Unload Me
End Sub
 
Private Sub cmdSpecial_Click()
    MsgBox "Hello World!", 0, vbNullString
End Sub
 
Private Sub UserForm_Initialize()
Dim lRetVal As Long
 
Const TITLEBAR_HGT As Double = 14
Const TITLEBAR_CAPTION As String = "Fake TitleBar"
    With Me '(frmFakeTitlebar)
        .Caption = "Fake Titlebar"
        .Width = 240
 
        With .lblTitleBar
            .BackColor = &H8000000F
            .BorderStyle = fmBorderStyleNone
            '// What the caption is doesn't matter, but we do need one, as we'll    //
            '// use it for SetWindowText                                            //
            .Caption = "My TitleBar"
            .Height = TITLEBAR_HGT
            .Width = .Parent.Width + 4
            .Left = -2
            .Top = 0
            .Picture = Me.imgMyTitlebar.Picture
        End With
        '// The image control would have a picture saved of whatever color/gradient //
        '// that best reflects the normal titlebar.  I believe that this is another //
        '// area where the workaround comes up short, as (didn't bother testing) I'm//
        '// fairly certain that if the user chooses different 'looks' for the       //
        '// windows' appearance, we cannot replicate on the fly?                    //
        '// Note that we set the image control's visibility to False, effectively   //
        '//burying it behind lblTitleBar                                            //
        With .imgMyTitlebar
            .BorderStyle = fmBorderStyleNone
            .Height = 15
            .Width = 244
            .Left = -2
            .Top = 0
            .Visible = False
        End With
        With .lblCaption
            .BackStyle = fmBackStyleTransparent
            .Caption = TITLEBAR_CAPTION
            With .Font
                .Bold = False
                .Name = "System"
                .Size = 9
                .Underline = False
            End With
            .ForeColor = &HFFFFFF
            .Height = TITLEBAR_HGT
            .Width = Me.Width * 0.667
            .Left = 2
            .Top = 0
            .TextAlign = fmTextAlignLeft
        End With
        '// Here's about the best I could manage.  As command buttons appear to have//
        '// a non-adjustable internal margin for the caption, same as the label used//
        '// as a titlebar, I used the picture property and cropped screen shots for //
        '// the images.  Admittedly extrememly rudimentary...                       //
        With .cmdClose
            .Height = 12
            .Width = 12
            .Left = .Parent.Width - 17
            .Top = 1
            .TabStop = False
        End With
 
        With .cmdSpecial
            .Height = 12
            .Width = 12
            .Left = .Parent.Width - 30
            .Top = 1
            .TabStop = False
        End With
 
        '// Now, any other controls we are adding need to be positioned offset to   //
        '// lblTitleBar's height, as using any type of common spacing such as 12 or //
        '// 6, would of course result in the control being up in the new 'titlebar's'//
        '// area.  Although I think this whole idea seems a bit mucky, I would use  //
        '// a Constant to at least make it a bit easier.                            //
        With .cmdCancel
            .Caption = "Unload"
            .Font.Size = 11
            .Height = 22
            .Width = 45
            .Left = 186
            .Top = TITLEBAR_HGT + 12
        End With
        .Height = .cmdCancel.Top + .cmdCancel.Height + 12
    End With
 
    '// Hide the normal titlebar                                                    //
    TitleBar_Hide Me, hWnd
    '// Get the fake titlebar (label) set up so it can be used to 'grab/drag' the   //
    '// form like the titlebar normally would.                                      //
    lRetVal = SetWindowText(hWnd, Me.lblTitleBar.Caption)
End Sub

Note: I am writing in xl2000, and for some reason, I seem to recall hWnd being available in 2003. I might well be recalling incorrectly, but of course if it is, this would save a step.

As mentioned, I certainly think this is too mucky. Regardless of opinion as to whether sticking extra buttons in the titlebar is the way to go about it, unless there is a proper way of getting a button added to the actual titlebar, I would be at Bob's question, as to why would we want to?

Regardless, if this is the route you want to take, I hope this helps,

Mark