Soru Userformu görev çubuğuna alma

Katılım
5 Kasım 2006
Mesajlar
583
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
 
Katılım
5 Kasım 2006
Mesajlar
583
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
Yokmu bir çözüm?
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,790
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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
 
Katılım
5 Kasım 2006
Mesajlar
583
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
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?
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Şu apileri kullanmaya nedense bir türlü ısınamadım.:cool:
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Ben Api kullanmıyorum.:cool:
 
Katılım
5 Kasım 2006
Mesajlar
583
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
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.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Apide ne yazdığını bilmiyorum.Onun için tercih etmiyorum.:cool:
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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:
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
API kullanmak antibiyotik kullanmak gibidir .... Sadece ve sadece gerektiği zaman, gerektiği kadar kullanmak gerekir.

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

.
 
Katılım
5 Kasım 2006
Mesajlar
583
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
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.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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
 
Katılım
5 Kasım 2006
Mesajlar
583
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
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.
 
Katılım
5 Kasım 2006
Mesajlar
583
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
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:
Katılım
5 Kasım 2006
Mesajlar
583
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
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:
Katılım
5 Kasım 2006
Mesajlar
583
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
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.
 
Katılım
5 Kasım 2006
Mesajlar
583
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
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

 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Bende dropbox çalışmıyor,başka yere ekleyin.:cool:
 
Üst