• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Userform Başlığı

Katılım
12 Nisan 2012
Mesajlar
533
Excel Vers. ve Dili
Microsoft office professional plus 2019
Arkadaşlar internet de araştırdım bir kaç tane kod buldum ama çalıştıramadım.Userform başlık çubuğunu kaldıracak kod arıyorum .Yabancı dili olan arkadaşlar yine yabancı internet sitelerinden araştırabilir diye düşünüyorum.Aşağıdaki kod bende çalışmadı.Findwindow komutu için hata veriyor.İlgilenecek arkadaşa teşekkür ederim.



Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long


bu koduda userform kod sayfasına yerleştirin.
Kod:
Private Sub UserForm_Activate()
Dim lngFormHwnd As Long
Dim lngFormStyle As Long

If Application.Version < 9 Then
lngFormHwnd = FindWindow("THUNDERXFRAME", Me.Caption)
Else
lngFormHwnd = FindWindow("THUNDERDFRAME", Me.Caption)
End If
lngFormStyle = GetWindowLong(lngFormHwnd, (-16))
lngFormStyle = lngFormStyle And Not &H800000
SetWindowLong lngFormHwnd, (-16), lngFormStyle
DrawMenuBar lngFormHwnd
 
Excel sürümünüz kaç bit?
 
Arkadaşlar internet de araştırdım bir kaç tane kod buldum ama çalıştıramadım.Userform başlık çubuğunu kaldıracak kod arıyorum .Yabancı dili olan arkadaşlar yine yabancı internet sitelerinden araştırabilir diye düşünüyorum.Aşağıdaki kod bende çalışmadı.Findwindow komutu için hata veriyor.İlgilenecek arkadaşa teşekkür ederim.



Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long


bu koduda userform kod sayfasına yerleştirin.
Kod:
Private Sub UserForm_Activate()
Dim lngFormHwnd As Long
Dim lngFormStyle As Long

If Application.Version < 9 Then
lngFormHwnd = FindWindow("THUNDERXFRAME", Me.Caption)
Else
lngFormHwnd = FindWindow("THUNDERDFRAME", Me.Caption)
End If
lngFormStyle = GetWindowLong(lngFormHwnd, (-16))
lngFormStyle = lngFormStyle And Not &H800000
SetWindowLong lngFormHwnd, (-16), lngFormStyle
DrawMenuBar lngFormHwnd


Merhaba, öncelikle boş bir modüle
Kod:
Option Explicit
Option Private Module

Public Const GWL_STYLE = -16
Public Const WS_CAPTION = &HC00000
#If VBA7 Then
    Public Declare PtrSafe Function GetWindowLong _
                           Lib "user32" Alias "GetWindowLongA" ( _
                           ByVal hwnd As LongPtr, _
                           ByVal nIndex As Long) As Long
    Public Declare PtrSafe Function SetWindowLong _
                           Lib "user32" Alias "SetWindowLongA" ( _
                           ByVal hwnd As LongPtr, _
                           ByVal nIndex As Long, _
                           ByVal dwNewLong As Long) As Long
    Public Declare PtrSafe Function DrawMenuBar _
                           Lib "user32" ( _
                           ByVal hwnd As LongPtr) As Long
    Public Declare PtrSafe Function FindWindowA _
                           Lib "user32" (ByVal lpClassName As String, _
                           ByVal lpWindowName As String) As LongPtr
#Else
    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
#End If
Sub HideTitleBar(frm As Object)
#If VBA7 Then
    Dim lFrmHdl As LongPtr
#Else
    Dim lFrmHdl As Long
#End If
    Dim lngWindow As Long
    lFrmHdl = FindWindowA(vbNullString, frm.Caption)
    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
    lngWindow = lngWindow And (Not WS_CAPTION)
    Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
    Call DrawMenuBar(lFrmHdl)
End Sub

Daha sonra UserForm sayfasına

Kod:
Private Sub UserForm_Initialize()
    HideTitleBar Me
End Sub

Yapıştırın. İşinizi görecektir. İyi çalışmalar dilerim.

Örnek dosya ektedir.
 

Ekli dosyalar

Userformunuzun VBA kısmını açarak aşağıdaki kodları olduğu gibi yapıştırın. Userformda başlık gideceği gibi userform da sabit kalıyor. İsterseniz sabit kalma kodunu da kapatabiliriz.

Kod:
#If Win64 Then

#Else

#End If

#If VBA7 Then
Private Declare PtrSafe Function GetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#Else
Private Declare Function GetWindowLongA Lib "USER32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "USER32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindowA Lib "USER32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Private Sub UserForm_Activate()
Dim hwnd As Long, exLong As Long
hwnd = FindWindowA(vbNullString, Me.Caption)
exLong = GetWindowLongA(hwnd, -16)
If exLong And &H880000 Then
    SetWindowLongA hwnd, -16, exLong And &HFF77FFFF
    Me.Hide: Me.Height = Me.Height - 16: Me.show
End If
End Sub
 
Aşağıdaki kodlarla da userformu hareket ettirebilirsiniz. Userformunuzun VBA kısmını açarak aşağıdaki kodları olduğu gibi yapıştırın.
Kod:
#If Win64 Then

#Else

#End If


#If VBA7 Then
Private Declare PtrSafe Function GetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#Else
Private Declare Function GetWindowLongA Lib "USER32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "USER32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindowA Lib "USER32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If



Private Sub UserForm_Activate()
Dim hwnd As Long
hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") & "Frame", Me.Caption)
SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
End Sub
 
Kodlar için sağolun bir tanesini çalıştırdım kullanıyorum.
 
Geri
Üst