DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
'===============================================================================================================>>>>
'Kaynak: www.Excel.Web.tr/Ali '||>
'Amaç: Userform üzerinde Başlık(Mavi Alan) ve Çarpı işaretinin gözükmemesi '||>
'Nerede: Userform kod sayfasının en üzerinde olacak '||>
'Link: http://www.excel.web.tr/showthread.php?t=22097&highlight=userform+kapat '||>
'Açıklama: hsayar '||>
Option Explicit '||>
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long '||>
Private Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, ByVal wCmd As Long) As Long '||>
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long '||>
Private Declare Function ReleaseCapture Lib "user32" () 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 CreateRectRgn Lib "gdi32" _
(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long '||>
Private Declare Function SetWindowRgn Lib "user32" _
(ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long '||>
Private Baslikalan&, Region& '||>
Private HauptBasliksiz&, ClientBasliksiz& '||>
Private dummy As Long '||>
Private Type RECT '||>
Left As Long '||>
Top As Long '||>
Right As Long '||>
Bottom As Long '||>
End Type '||>
Private Const GW_CHILD = 5 '||>
Private Const WM_NCLBUTTONDOWN = &HA1 '||>
Private Const HTCAPTION = 2 '||>
Private Sub Basliksiz(Form As Object, Alanayari As RECT, Alanayar As RECT) '||>
Dim Fenstername$, Suchstring$ '||>
Suchstring = "UserForm ohne Titelzeile" '||>
Fenstername = Form.Caption '||>
Form.Caption = Suchstring '||>
HauptBasliksiz = FindWindow(vbNullString, Suchstring) '||>
Form.Caption = Fenstername '||>
ClientBasliksiz = GetWindow(HauptBasliksiz, GW_CHILD) '||>
dummy = GetWindowRect(HauptBasliksiz, Alanayari) '||>
dummy = GetWindowRect(ClientBasliksiz, Alanayar) '||>
End Sub '||>
Sub Baslikayari() '||>
Dim Alanayari As RECT '||>
Dim Alanayar As RECT '||>
Dim Pos1x&, Pos1y&, Pos2x&, Pos2y& '||>
If Baslikalan <> 0 Then Exit Sub '||>
UserForm1.BorderStyle = fmBorderStyleSingle '||>
Call Basliksiz(UserForm1, Alanayari, Alanayar) '||>
Pos1x = 0 '||>
Pos1y = (Alanayar.Top - Alanayari.Top) '||>
Pos2x = Alanayari.Right - Alanayari.Left '||>
Pos2y = Alanayari.Bottom - Alanayari.Top '||>
Region = CreateRectRgn(Pos1x, Pos1y, Pos2x, Pos2y) '||>
Baslikalan = SetWindowRgn(HauptBasliksiz, Region, True) '||>
End Sub '||>
'===============================================================================================================<<<<
Private Sub UserForm_Initialize()
Call Baslikayari 'userform ekrana yukarıdaki kodlar sayesinde başlıksız ve çarpsısız olarak gelir.
End Sub
'===============================================================================================================>>>>
'Kaynak: www.Excel.Web.tr/Ali '||>
'Amaç: Userform üzerinde Başlık(Mavi Alan) ve Çarpı işaretinin gözükmemesi '||>
'Nerede: Userform kod sayfasının en üzerinde olacak '||>
'Link: http://www.excel.web.tr/showthread.php?t=22097&highlight=userform+kapat '||>
'Açıklama: hsayar '||>
Option Explicit '||>
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long '||>
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long '||>
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long '||>
Private Declare Function ReleaseCapture Lib "user32" () 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 CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long '||>
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long '||>
Private Baslikalan&, Region& '||>
Private HauptBasliksiz&, ClientBasliksiz& '||>
Private dummy As Long '||>
Private Type RECT '||>
Left As Long '||>
Top As Long '||>
Right As Long '||>
Bottom As Long '||>
End Type '||>
Private Const GW_CHILD = 5 '||>
Private Const WM_NCLBUTTONDOWN = &HA1 '||>
Private Const HTCAPTION = 2 '||>
Private Sub Basliksiz(Form As Object, Alanayari As RECT, Alanayar As RECT) '||>
Dim Fenstername$, Suchstring$ '||>
Suchstring = "UserForm ohne Titelzeile" '||>
Fenstername = Form.Caption '||>
Form.Caption = Suchstring '||>
HauptBasliksiz = FindWindow(vbNullString, Suchstring) '||>
Form.Caption = Fenstername '||>
ClientBasliksiz = GetWindow(HauptBasliksiz, GW_CHILD) '||>
dummy = GetWindowRect(HauptBasliksiz, Alanayari) '||>
dummy = GetWindowRect(ClientBasliksiz, Alanayar) '||>
End Sub '||>
Sub Baslikayari() '||>
Dim Alanayari As RECT '||>
Dim Alanayar As RECT '||>
Dim Pos1x&, Pos1y&, Pos2x&, Pos2y& '||>
If Baslikalan <> 0 Then Exit Sub '||>
[B][color="red"]Me[/color][/B].BorderStyle = fmBorderStyleSingle '||>
Call Basliksiz([B][color="red"]Me[/color][/B], Alanayari, Alanayar) '||>
Pos1x = 0 '||>
Pos1y = (Alanayar.Top - Alanayari.Top) '||>
Pos2x = Alanayari.Right - Alanayari.Left '||>
Pos2y = Alanayari.Bottom - Alanayari.Top '||>
Region = CreateRectRgn(Pos1x, Pos1y, Pos2x, Pos2y) '||>
Baslikalan = SetWindowRgn(HauptBasliksiz, Region, True) '||>
End Sub '||>
'===============================================================================================================<<<<
Private Sub UserForm_Initialize()
Call Baslikayari 'userform ekrana yukarıdaki kodlar sayesinde başlıksız ve çarpsısız olarak gelir.
End Sub
Çoç güzel bi çalışma, ellerinize sağlık.
peki Çarpı kapatma tuşuna basıldığında "verileri kaydediğim mi?" diye bi soru çıkartabilir miyiz?
yani Çarpı tuşuna işlev eklemek mümkün mü?
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If MsgBox("Seçili Kayıt Değiştirilsinmi?", vbYesNo) = vbNo Then Exit Sub
'Diğer Kodlarınızı Buraya Yazınız
End Sub
Public Declare Function GetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Sub X_yok(Form As Object)
Dim hwnd As Long
hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") & "Frame", Form.Caption)
SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
End Sub
Private Sub UserForm_Initialize()
Call X_yok(Me)
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub