Ẩn (hoặc làm mất) phần caption của UserForm như thế nào?

[Deleted member 208]

Cả nhà cho em hỏi, có cách nào để ẩn hoặc làm mất phần caption màu đỏ đi không ạ? Em chỉ muốn UserForm còn lại phần màu xanh, nhìn cho đẹp thôi ạ.

Bạn cần đăng nhập để thấy hình ảnh

 

[vothanhthu]

Code này Thứ đơn giản là Google " Hide caption userform" lấy kết quả đầu tiên
Bạn gõ chữ Caption (Đầu đề) thành Capital (Thủ đô) trong tiêu đề thì phải?
Nguồn:

Bạn cần đăng nhập để thấy link

*** Place this code In a User Form ***

Option Explicit

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

*** Place this code In a 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 RemoveCaption(objForm As Object)
 
    Dim lStyle          As Long
    Dim hMenu           As Long
    Dim mhWndForm       As Long
 
    If Val(Application.Version) < 9 Then
        mhWndForm = FindWindow("ThunderXFrame", objForm.Caption) 'XL97
    Else
        mhWndForm = FindWindow("ThunderDFrame", objForm.Caption) 'XL2000+
    End If
    lStyle = GetWindowLong(mhWndForm, -16)
    lStyle = lStyle And Not &HC00000
    SetWindowLong mhWndForm, -16, lStyle
    DrawMenuBar mhWndForm
 
End Sub

Sub ShowForm()
 
    UserForm1.Show False
 
End Sub

 

[Deleted member 208]

Em cám ơn ạ. Em đã sửa lại bài viết và thử google và làm được rồi.

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" _
                Alias "FindWindowA" _
               (ByVal lpClassName As String, _
                ByVal lpWindowName As String) As Long


    Private Declare PtrSafe Function GetWindowLong Lib "user32" _
                Alias "GetWindowLongA" _
               (ByVal hWnd As Long, _
                ByVal nIndex As Long) As Long


    Private Declare PtrSafe Function SetWindowLong Lib "user32" _
                Alias "SetWindowLongA" _
               (ByVal hWnd As Long, _
                ByVal nIndex As Long, _
                ByVal dwNewLong As Long) As Long


    Private Declare PtrSafe Function DrawMenuBar Lib "user32" _
               (ByVal hWnd As Long) As Long
#Else
    Public Declare Function FindWindow Lib "user32" _
                Alias "FindWindowA" _
               (ByVal lpClassName As String, _
                ByVal lpWindowName 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
#End If


Sub HideBar(frm As Object)

Dim Style As Long, Menu As Long, hWndForm As Long
hWndForm = FindWindow("ThunderDFrame", frm.Caption)
Style = GetWindowLong(hWndForm, &HFFF0)
Style = Style And Not &HC00000
SetWindowLong hWndForm, &HFFF0, Style
DrawMenuBar hWndForm

End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()

'Remove Border and Title Bar
HideBar Me

End Sub

Bạn cần đăng nhập để thấy hình ảnh

Link:

Bạn cần đăng nhập để thấy link

 

[maiban2068]

Code #3 không thấy di chuyển được UserForm.
Google được code này, đáp ứng được như #3 mà kéo chuột di chuyển US vẫn OK.

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

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

Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Const GWL_STYLE As Long = -16
Private Const WS_CAPTION As Long = &HC00000

Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1

Private hWndForm As Long
Private bCaption As Boolean

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
  If Val(Application.Version) >= 9 Then
    hWndForm = FindWindow("ThunderDFrame", Me.Caption)
  Else
    hWndForm = FindWindow("ThunderXFrame", Me.Caption)
  End If

  bCaption = False
  SetUserFormStyle
End Sub

Private Sub SetUserFormStyle()
  Dim frmStyle As Long

  If hWndForm = 0 Then Exit Sub

  frmStyle = GetWindowLong(hWndForm, GWL_STYLE)

  If bCaption Then
    frmStyle = frmStyle Or WS_CAPTION
  Else
    frmStyle = frmStyle And Not WS_CAPTION
  End If

  SetWindowLong hWndForm, GWL_STYLE, frmStyle

  DrawMenuBar hWndForm
End Sub

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal _
        Shift As Integer, ByVal X As Single, ByVal Y As Single)

  If hWndForm = 0 Then Exit Sub

  If Button = 1 Then
     ReleaseCapture
     SendMessage hWndForm, WM_NCLBUTTONDOWN, HTCAPTION, 0
  End If
End Sub

Private Sub optCaptionOn_Click()
  bCaption = True
  SetUserFormStyle
End Sub

Private Sub optCaptionOff_Click()
  bCaption = False
  SetUserFormStyle
End Sub

Nguồn:

Bạn cần đăng nhập để thấy link