• DİKKAT

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

Soru Userformu görev çubuğuna alma

  • Konbuyu başlatan Konbuyu başlatan FERAZ
  • Başlangıç tarihi Başlangıç tarihi
Katılım
5 Kasım 2006
Mesajlar
603
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
Merhaba.

Alttaki kod ile userforma büyütme ve küçültme işareti geliyor üst sağ çarpının oraya.
Ve küçültme işaretine basınca görev çubuğuna iniyor ve orda userform görüküyor.
Benim yapamadığım userformun açılışında userformun kaybolması ve görevçubuğunda görünür durması.
me.hide işe yaramdı.Bunu ekleyine görevçubuğunda görükmüyor.

https://www.dropbox.com/s/f4biyswwbdhqxz1/Userform Görev cubuk.xlsm?dl=0

PHP:
#If Win64 Then
    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 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 PtrSafe Function FindWindow Lib "user32" _
    Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll" () As Long
    Private Declare PtrSafe 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 PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
#Else
    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
#End If


Private Const EVN_TASINMA = &H2 '
Private Const EVN_BOYUTLANMA = &H1 '
Private Const EVN_STIL = (-20) '
Private Const EVN_UST = 0 '
Private Const EVN_AKTIFDEGIL = &H10 '
Private Const EVN_GIZLE = &H80 '
Private Const EVN_GOSTER = &H40 '
Private Const EVN_PENCERE = &H40000 '
Private Const EVN_STILI = (-16) '
Private Const EVN_KUCULTBUTON = &H20000 '
Private Const EVN_BUYUTBUTON = &H10000 '
Private Const EVN_DEGIS = &H20 '
Private hwnd As Long
Private WSTILI As Long
Private SONUC As Long


Private Function KucultButonuEkle() As Long
    hwnd = GetActiveWindow
    Call SetWindowLong(hwnd, EVN_STILI, _
        GetWindowLong(hwnd, EVN_STILI) Or EVN_KUCULTBUTON)
    Call SetWindowPos(hwnd, 0, 0, 0, 0, 0, _
        EVN_DEGIS Or EVN_TASINMA Or EVN_BOYUTLANMA)
End Function

Private Function BuyutButonuEkle() As Long
    hwnd = GetActiveWindow
    Call SetWindowLong(hwnd, EVN_STILI, _
        GetWindowLong(hwnd, EVN_STILI) Or EVN_BUYUTBUTON)
    Call SetWindowPos(hwnd, 0, 0, 0, 0, 0, _
        EVN_DEGIS Or EVN_TASINMA Or EVN_BOYUTLANMA)
End Function

Private Function GorevCubugundaGoster(Formum) As Long
    hwnd = FindWindow(vbNullString, Formum.Caption)
    WSTILI = GetWindowLong(hwnd, EVN_STIL)
    WSTILI = WSTILI Or EVN_PENCERE
    SONUC = SetWindowPos(hwnd, EVN_UST, 0, 0, 0, 0, _
        EVN_TASINMA Or EVN_BOYUTLANMA Or EVN_AKTIFDEGIL Or EVN_GIZLE)
        SONUC = SetWindowLong(hwnd, EVN_STIL, WSTILI)
        SONUC = SetWindowPos(hwnd, EVN_UST, 0, 0, 0, 0, _
        EVN_TASINMA Or EVN_BOYUTLANMA Or EVN_AKTIFDEGIL Or EVN_GOSTER)
End Function


Private Sub UserForm_Activate()

    KucultButonuEkle
    BuyutButonuEkle
    Call GorevCubugundaGoster(Me)
'    Me.Left = Application.Left
'    Me.Top = Application.Top
'    Me.Height = Application.Height
'    Me.Width = Application.Width
    
    
End Sub
 
Kod:

Kod:
#If Win64 Then
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 FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#Else
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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If


Dim g_hForm

Private Sub UserForm_Activate()

g_hForm = FindWindow(vbNullString, Me.Caption)
SetWindowLong g_hForm, -16, &H20000 Or &H10000 Or &H84C80080

Dim hWnd As Long
hWnd = FindWindow(vbNullString, Me.Caption)
SetWindowLong hWnd, -16, GetWindowLong(hWnd, -16) Or &H10000 _
Or &H20000 Or &H40000

Dim lngHwnd As Long
Dim lngCurrentStyle As Long, lngNewStyle As Long

If Val(Application.Version) < 9 Then
lngHwnd = FindWindow("ThunderXFrame", Me.Caption) 'XL97
Else
lngHwnd = FindWindow("ThunderDFrame", Me.Caption) 'XL2000, XP, 2003?
End If

'_____Forma minimise and maximise button eklemek_____
lngCurrentStyle = GetWindowLong(lngHwnd, -16)
lngNewStyle = lngCurrentStyle Or 131072 Or 65536
lngNewStyle = lngNewStyle And Not 268435456 And Not &H80000000
SetWindowLong lngHwnd, -16, lngNewStyle

'_____Formun görev çubuğunda simge durumuna gelmesi_____
lngCurrentStyle = GetWindowLong(lngHwnd, -20)
lngNewStyle = lngCurrentStyle Or 262144
SetWindowLong lngHwnd, -20, lngNewStyle
ShowWindow lngHwnd, 5

End Sub
 
Tamam Halit hocam bugün müsait olunca deneyeceğim.
Kod bayağı bir kısaymış benimkine nazaran :)
Birde userforma icon yani en üst soldaki yere konabilir mi?
 
Şu apileri kullanmaya nedense bir türlü ısınamadım.:cool:
 
Ben Api kullanmıyorum.:cool:
 
Ben Api kullanmıyorum.:cool:
Dezavantajı felan vada onun içinmi kullanmıyorsunuz?
Mesela userforma büyütme işareti Apisiz nasıl oluyor?
Benim bu başlıktaki konu açmamın sebebi butona tıklayınca yazıcı önizleme çıkıyor ve me.hide ekleyince bir türlü istediğim olmadı.
Yani hide yapınca araki bir daha bulasın userformu :)
Onun için Api şart gibi bazı yerlerde.
 
Apide ne yazdığını bilmiyorum.Onun için tercih etmiyorum.:cool:
 
Ayrıca 32 bit ve 64 bit sistemlerde hata veriyor.Onu düzeltmek için ilave bir kaç satır yazmak gerekiyor.
Yarın 64 bitten daha büyük bir sistem olursa ne olacak.Bu yazdıklarınız çalışmayacak.vs,vs,vs.:cool:
 
API kullanmak antibiyotik kullanmak gibidir .... Sadece ve sadece gerektiği zaman, gerektiği kadar kullanmak gerekir.

Fazlası, bünyeye (Excel'e) zarar verir....

.
 
Benimi kullandığım daha doğrusu mecbur kullanmak zorunda olduklarım;

1:Sendkeys ler için Numlock olayında.
2:Yazdığım gibi yazıcı önizle olayında userformun kaybolmadan görev çubuğuna gelmesi.
3:Bu mecburluktan değil userforma büyütme ve küçültme işaretleri koydurtmak.

Yani mecbur olduğum için ilk ikideki yazdığım olaylar.
 
Sayın FERAZ,
Userform gizleniyor.
Yazdırma ekranı çıkıyor.
İşiniz bittikten sonra Yazdırma ekranını kapatınca userform tekrar görünür oluyor.
Userforma bir button ekleyin ve aşağıdaki kodu yazın.:cool:
Kod:
Private Sub CommandButton1_Click()
Me.Hide
Sheets("Sayfa1").PrintPreview
Me.Show
End Sub
 
Sayın FERAZ,
Userform gizleniyor.
Yazdırma ekranı çıkıyor.
İşiniz bittikten sonra Yazdırma ekranını kapatınca userform tekrar görünür oluyor.
Userforma bir button ekleyin ve aşağıdaki kodu yazın.:cool:
Kod:
Private Sub CommandButton1_Click()
Me.Hide
Sheets("Sayfa1").PrintPreview
Me.Show
End Sub
Sayın FERAZ,
Userform gizleniyor.
Yazdırma ekranı çıkıyor.
İşiniz bittikten sonra Yazdırma ekranını kapatınca userform tekrar görünür oluyor.
Userforma bir button ekleyin ve aşağıdaki kodu yazın.:cool:
Kod:
Private Sub CommandButton1_Click()
Me.Hide
Sheets("Sayfa1").PrintPreview
Me.Show
End Sub
Böyle yöntemi denemiştim ve sorun oluyordu başka kodlarda vardı.
Bir daha deneyeyim sonra.
 
Kod:

Kod:
#If Win64 Then
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 FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#Else
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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If


Dim g_hForm

Private Sub UserForm_Activate()

g_hForm = FindWindow(vbNullString, Me.Caption)
SetWindowLong g_hForm, -16, &H20000 Or &H10000 Or &H84C80080

Dim hWnd As Long
hWnd = FindWindow(vbNullString, Me.Caption)
SetWindowLong hWnd, -16, GetWindowLong(hWnd, -16) Or &H10000 _
Or &H20000 Or &H40000

Dim lngHwnd As Long
Dim lngCurrentStyle As Long, lngNewStyle As Long

If Val(Application.Version) < 9 Then
lngHwnd = FindWindow("ThunderXFrame", Me.Caption) 'XL97
Else
lngHwnd = FindWindow("ThunderDFrame", Me.Caption) 'XL2000, XP, 2003?
End If

'_____Forma minimise and maximise button eklemek_____
lngCurrentStyle = GetWindowLong(lngHwnd, -16)
lngNewStyle = lngCurrentStyle Or 131072 Or 65536
lngNewStyle = lngNewStyle And Not 268435456 And Not &H80000000
SetWindowLong lngHwnd, -16, lngNewStyle

'_____Formun görev çubuğunda simge durumuna gelmesi_____
lngCurrentStyle = GetWindowLong(lngHwnd, -20)
lngNewStyle = lngCurrentStyle Or 262144
SetWindowLong lngHwnd, -20, lngNewStyle
ShowWindow lngHwnd, 5

End Sub

Şimdi deneme fırsatım oldu.Fakat userform açılışında otomatik olarak görev çubuğunun oraya varmıyor.
Yani en üstteki - olan yeri tıklamalı gibi alet.
 
Son düzenleme:
Sayın FERAZ,
Userform gizleniyor.
Yazdırma ekranı çıkıyor.
İşiniz bittikten sonra Yazdırma ekranını kapatınca userform tekrar görünür oluyor.
Userforma bir button ekleyin ve aşağıdaki kodu yazın.:cool:
Kod:
Private Sub CommandButton1_Click()
Me.Hide
Sheets("Sayfa1").PrintPreview
Me.Show
End Sub

Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint") bunu kullanıyorum Sheets("Sayfa1").PrintPreview yerine o yüzden dediğim olmuyor.
Bu kodu bir denerseniz dediğim tam anlaşılır hocam.

PHP:
Private Sub CommandButton1_Click()
    Me.Hide
    Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
    Me.Show
End Sub
 
Son düzenleme:
Ayrıca 32 bit ve 64 bit sistemlerde hata veriyor.Onu düzeltmek için ilave bir kaç satır yazmak gerekiyor.
Yarın 64 bitten daha büyük bir sistem olursa ne olacak.Bu yazdıklarınız çalışmayacak.vs,vs,vs.:cool:

O zamana kadar kim öle kim kala sayın hocam :)
64 bitten sonrası heralde 128 bit olur.O da bizim devire denk gelmez :)
Gelirsede kodu bulurlar uzmanlar bizde kendi kodumuza ekleriz.
 
Sayın FERAZ,
Userform gizleniyor.
Yazdırma ekranı çıkıyor.
İşiniz bittikten sonra Yazdırma ekranını kapatınca userform tekrar görünür oluyor.
Userforma bir button ekleyin ve aşağıdaki kodu yazın.:cool:
Kod:
Private Sub CommandButton1_Click()
Me.Hide
Sheets("Sayfa1").PrintPreview
Me.Show
End Sub

[/CODE][/QUOTE]

Sayın Orion1 hocam dediğim dosyayı bir denermisiniz?
Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint") ile yaptım.
Gifteki gibi userform önce kaybolup sonra açılmıyor.

https://www.dropbox.com/s/cs9u3jeelrnola4/userform test hide prientview.xlsm?dl=0

 
Bende dropbox çalışmıyor,başka yere ekleyin.:cool:
 
Geri
Üst