• DİKKAT

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

Form minimize etmek için kod girişi yapılınca butonlar hata veriyor

E

Emsdmr

Katılım
18 Mayıs 2009
Mesajlar
166
Excel Vers. ve Dili
Office 2003 Türkçe
Değerli hocalarım;
Formu Minimize etmek için uyguladığım kod aşağıdadır ancak bu kod uygulandıktan sonra form üzerindeki butonlar hata veriyor sebebi ne olabilir acaba
verdiği hata bu
Compile error in hidden modüle :Userform1

Kod: 
Option Explicit
 
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 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" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" _
() 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 DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long
 
 
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Sub UserForm_activate()
AddMinimiseButton
AppTasklist Me
End Sub
Private Sub AddMinimiseButton()
Dim hWnd As Long
hWnd = GetActiveWindow
Call SetWindowLong(hWnd, GWL_STYLE, _
GetWindowLong(hWnd, GWL_STYLE) Or _
WS_MINIMIZEBOX)
Call SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
SWP_FRAMECHANGED Or _
SWP_NOMOVE Or _
SWP_NOSIZE)
End Sub
Private Sub AppTasklist(myForm)
Dim WStyle As Long
Dim Result As Long
Dim hWnd As Long
 
hWnd = FindWindow(vbNullString, myForm.Caption)
WStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
WStyle = WStyle Or WS_EX_APPWINDOW
Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or _
SWP_NOSIZE Or _
SWP_NOACTIVATE Or _
SWP_HIDEWINDOW)
Result = SetWindowLong(hWnd, GWL_EXSTYLE, WStyle)
Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or _
SWP_NOSIZE Or _
SWP_NOACTIVATE Or _
SWP_SHOWWINDOW)
End Sub
 
Son düzenleme:
Benim sorunum Yardımcı olun. lütfen ............

Personel çalışma saatlerinin kayıtlarından excele aktarım yaptığımda çıkan dosyayı aynenen gönderiyorum benim istediğim 19:30 dan sonraki mesai saatleri ve gereksiz sütunların silinmesi..
 
Yardımm

Personel çalışma saatlerinin kayıtlarından excele aktarım yaptığımda çıkan dosyayı aynenen gönderiyorum benim istediğim 19:30 dan sonraki mesai saatleri ve gereksiz sütunların silinmesi..
 
sayın rimaks dosyanızı ekte gönderirseniz yardımcı olmaya çalışırım
mesaj yazdığınız bloğun altında gelişmod yazan yerden giriş yapın açılan ek blokta dosya ekle sekmesinden ekleyebilirsiniz
 
saygı değer hocalarım yardımlarınızı bekliyorum
 
şu kodları deneyin
'API fonksiyonlar
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 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" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" _
() 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 DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long


'Sabitler
Private Const LVM_FIRST = &H1000
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
Private Sub UserForm_Activate()

'Userform basligina minimize buton ekle
AddMinimiseButton
'Userformu system tray e indir
AppTasklist Me
' TEXTBOXLAR IÇIN KES KOPYALA YAPISTIR MENÜSÜ OLUSTURULUYOR




Set MyData = New DataObject
End Sub
Private Sub AddIcon()
'basliga icon ekler
Dim hWnd As Long
Dim lngRet As Long
Dim hIcon As Long
hIcon = Sayfa2.Image1.Picture.Handle 'image hangi sayfada ise düzelt
hWnd = FindWindow(vbNullString, Me.Caption)
lngRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
lngRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
lngRet = DrawMenuBar(hWnd)
End Sub
Private Sub AddMinimiseButton()
'Userform'a Minimize butonu ekle
Dim hWnd As Long
hWnd = GetActiveWindow
Call SetWindowLong(hWnd, GWL_STYLE, _
GetWindowLong(hWnd, GWL_STYLE) Or _
WS_MINIMIZEBOX)
Call SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
SWP_FRAMECHANGED Or _
SWP_NOMOVE Or _
SWP_NOSIZE)
End Sub
Private Sub AppTasklist(myForm)
'Task bar'a Userform'u indirir
Dim WStyle As Long
Dim Result As Long
Dim hWnd As Long

hWnd = FindWindow(vbNullString, myForm.Caption)
WStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
WStyle = WStyle Or WS_EX_APPWINDOW
Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or _
SWP_NOSIZE Or _
SWP_NOACTIVATE Or _
SWP_HIDEWINDOW)
Result = SetWindowLong(hWnd, GWL_EXSTYLE, WStyle)
Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or _
SWP_NOSIZE Or _
SWP_NOACTIVATE Or _
SWP_SHOWWINDOW)
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
' FORM KAPATILIRKEN AKTIVASYON TUSLAR IPTAL EDILIYOR
Application.Visible = True ' Excel'i görünür yap
Set m_objActiveTB = Nothing
Set mcol_TextBoxes = Nothing
End Sub
Public Property Set ActiveTextBox(ByVal objTextBox As _
MSForms.TextBox)
' TEXTBOXLAR IÇIN KES KOPYALA YAPISTIR MENÜSÜ OLUSTURULUYOR
Set m_objActiveTB = objTextBox
End Property
Public Property Get ActiveTextBox() As MSForms.TextBox
' TEXTBOXLAR IÇIN KES KOPYALA YAPISTIR MENÜSÜ OLUSTURULUYOR
Set ActiveTextBox = m_objActiveTB
End Property
 
rimaks' Alıntı:
Personel çalışma saatlerinin kayıtlarından excele aktarım yaptığımda çıkan dosyayı aynenen gönderiyorum benim istediğim 19:30 dan sonraki mesai saatleri ve gereksiz sütunların silinmesi..
Genişletmek için tıkla ...

Sn rimaks, açılmış bir konunun içinde, alakasız bir soru soruyorsunuz. önce forumda arama yapın. bulamazsanız, uygun başlık altında yeni bir konu açarak sorun sorunuzu
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst