Userform üzerine simge durumuna küçült nasıl yerleştir

Katılım
18 Şubat 2005
Mesajlar
94
Excel Vers. ve Dili
excel 2013 türkçe
Altın Üyelik Bitiş Tarihi
06.10.2023
iyi akşamlar excel ve vba dostları bir userform üzerine simge durumuna küçült işareti yerleştirerek bunla alakalı kodlar nasıl olacak.birde userformu simge durumuna getirdiyimde çalışma kitabıda simde durumuna geçmeli.Bunun VBA ile yapılabilirliği mümkünmüdür .herkese iyi çalışmalar.
 
Katılım
18 Şubat 2005
Mesajlar
94
Excel Vers. ve Dili
excel 2013 türkçe
Altın Üyelik Bitiş Tarihi
06.10.2023
Bu arada üzerinde yapmaya çalıştığım bir program var bu forumdan çok çok faydalandım.Formun bütün yönetici ve kod yazarlarına teşekkür ediyorum.Bende emeği fazlasıyla olan özelliklikle sn: LEVENT sn: HALUK dostlarımıza ayrıca teşekkür ediyorum.
 

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
Rica ederiz.

Bu arada, UserForm'a simge durumuna küçültecek düğmenin eklenmesini aşağıdaki kodlarla yapabilirsiniz.

Kod:
Private Declare PtrSafe Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 Sub UserForm_Activate()
    Dim hWnd As Long, exLong As Long
    hWnd = FindWindowA(vbNullString, Me.Caption)
    exLong = GetWindowLongA(hWnd, -16)
    If (exLong And &H20000) = 0 Then
        SetWindowLongA hWnd, -16, exLong Or &H20000
        Me.Hide
        Me.Show
    End If
End Sub
 
Son düzenleme:
Katılım
18 Şubat 2005
Mesajlar
94
Excel Vers. ve Dili
excel 2013 türkçe
Altın Üyelik Bitiş Tarihi
06.10.2023
sn: Haluk bey elinize ve emeğinize sağlık kodlar güzel çalışıyor sorun yok.
userform simge durumuna gelirken üzerinde çalıştığım excel çalışma kitabımda onla beraber hareket edip simde durumuna geçsin bu olabilirmi.Bu arada tekrar kodlar için sağol Allah sağlıklı ömüzler versin.
 
Katılım
3 Nisan 2005
Mesajlar
347
Excel Vers. ve Dili
office xp tr
FORUMUN TAM EKRAN VE SÝMGE DURUMUNA GETÝRÝLMESÝ

Haluk beyin koduna ilave formun tam ekran olması
'FORMUN TAM EKRAN NORMAL EKRAN VE ALTA SİMGE DURUMUNDA KÜÇÜLTÜLMESİNİ SAÐLAR
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
'YUKARDAKİ İLE BİR (TAM EKRAN NORMAL EKRAN)
Private Sub UserForm_Activate()
Dim hWndForm As Long, frmStyle As Long
hWndForm = FindWindow(vbNullString, Me.Caption)
frmStyle = GetWindowLong(hWndForm, (-16))
frmStyle = frmStyle Or &H80000 Or &H20000 Or &H10000
SetWindowLong hWndForm, (-16), frmStyle
ShowWindow hWndForm, 5
DrawMenuBar hWndForm
End Sub
 
Katılım
10 Ekim 2004
Mesajlar
242
Haluk bey günaydın bu kodları nereye yazacağım acaba.Birde simge durumuna küçültecek olan düğme otomatik olarakmı eklenecek.

Selamlar.
 

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
Katılım
14 Ocak 2005
Mesajlar
792
Excel Vers. ve Dili
Ofis 2010 2016
Altın Üyelik Bitiş Tarihi
13/03/2022
Sayın Haluk, Bey,

Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 Sub UserForm_Activate()
Dim hWnd As Long, exLong As Long
hWnd = FindWindowA(vbNullString, Me.Caption)
exLong = GetWindowLongA(hWnd, -16)
If (exLong And &H20000) = 0 Then
SetWindowLongA hWnd, -16, exLong Or &H20000
Me.Hide: Me.Show
End If
End Sub





Private Sub UserForm_Initialize()






ListBox1.MultiSelect = fmMultiSelectMulti

'txtSNo yani Sipariş Sıra no atıyor ver sayfasından en son kaydın değerine 1 arttırara buraya getiriyor

DTPicker1.Value = Date
DTPicker2.Value = Date

Worksheets("veri").Select
Range("A8").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
txtSNo.Value = ActiveCell.Offset(-1, 0) + 1

cbDepartman.SetFocus

Dim sonhucre As Integer
cbMlzismi.ListRows = 20
cbMlzismi.ListWidth = 150
'KLAVYEDEN GİRİLEN ÖĞENİN TAMAMINI GÖRÜNTÜLER
cbMlzismi.MatchEntry = fmMatchEntryComplete
'LİSTEDE VARSA KABUL EDER YOKSA YOK DER
cbMlzismi.MatchRequired = True

sonhucre = WorksheetFunction.CountA(Worksheets("Mlz_ismi").Range("B2:B65536")) + 1
cbMlzismi.RowSource = "Mlz_ismi!B2:B" & sonhucre

cbDepartman.ListRows = 10
cbDepartman.RowSource = "Departmanlar!B2:B" & WorksheetFunction.CountA(Worksheets("Departmanlar").Range("B2:B65536")) + 1
'KLAVYEDEN GİRİLEN ÖĞENİN TAMAMINI GÖRÜNTÜLER
cbDepartman.MatchEntry = fmMatchEntryComplete
'LİSTEDE VARSA KABUL EDER YOKSA YOK DER
cbDepartman.MatchRequired = True


'1Firma İçin Combobox kodları

cb1Firma.ListRows = 10
cb1Firma.ListWidth = 150
cb1Firma.RowSource = "Firmalar!B2:B" & WorksheetFunction.CountA(Worksheets("Firmalar").Range("B2:B65536")) + 1
'KLAVYEDEN GİRİLEN ÖĞENİN TAMAMINI GÖRÜNTÜLER
cb1Firma.MatchEntry = fmMatchEntryComplete
'LİSTEDE VARSA KABUL EDER YOKSA YOK DER
cb1Firma.MatchRequired = True


'2Firma İçin Combobox kodları
cb2Firma.ListRows = 10
cb2Firma.ListWidth = 150
cb2Firma.RowSource = "Firmalar!B2:B" & WorksheetFunction.CountA(Worksheets("Firmalar").Range("B2:B65536")) + 1
'KLAVYEDEN GİRİLEN ÖĞENİN TAMAMINI GÖRÜNTÜLER
cb2Firma.MatchEntry = fmMatchEntryComplete
'LİSTEDE VARSA KABUL EDER YOKSA YOK DER
cb2Firma.MatchRequired = True

'3Firma İçin Combobox kodları

cb3Firma.ListRows = 10
cb3Firma.ListWidth = 150
cb3Firma.RowSource = "Firmalar!B2:B" & WorksheetFunction.CountA(Worksheets("Firmalar").Range("B2:B65536")) + 1
'KLAVYEDEN GİRİLEN ÖĞENİN TAMAMINI GÖRÜNTÜLER
cb3Firma.MatchEntry = fmMatchEntryComplete
'LİSTEDE VARSA KABUL EDER YOKSA YOK DER
cb3Firma.MatchRequired = True


cbKBirim.ListRows = 10
cbKBirim.AddItem "KG"
cbKBirim.AddItem "GR"
cbKBirim.AddItem "AD"
cbKBirim.AddItem "KS"
cbKBirim.AddItem "KL"
cbKBirim.AddItem "ŞİŞE"
cbKBirim.AddItem "ÇVL"
cbKBirim.MatchEntry = fmMatchEntryComplete
'KLAVYEDEN GİRİLEN ÖĞENİN TAMAMINI GÖRÜNTÜLER
cbKBirim.MatchRequired = True

'LİSTEDE VARSA KABUL EDER YOKSA YOK DER

cbKBirim.ListRows = 10
cbKKdv.AddItem "18"
cbKKdv.AddItem "8"
cbKKdv.AddItem "1"
cbKKdv.AddItem "0"
'KLAVYEDEN GİRİLEN ÖĞENİN TAMAMINI GÖRÜNTÜLER
cbKKdv.MatchEntry = fmMatchEntryComplete
'LİSTEDE VARSA KABUL EDER YOKSA YOK DER
cbKKdv.MatchRequired = True

txt1KdvHBF.Value = 0
txt1KdvHTT.Value = 0
txt1KdvDTT.Value = 0

txt2KdvHBF.Value = 0
txt2KdvHTT.Value = 0
txt2KdvDTT.Value = 0


txt3KdvHBF.Value = 0
txt3KdvHTT.Value = 0
txt3KdvDTT.Value = 0


' LİST BOX A VERİLERİ AKTARIR
CommandButton5_Click

End Sub

Benim UserForm daki kodlarım bu şekilde ben bu kodları ekleyince hata mesajı ile karşılaşıyorum; (Only comments may appear after End Sub, End Function, or End Property) şeklinde compile Error Mesajı alıyorum Sorun nedir?
 
Katılım
2 Haziran 2006
Mesajlar
111
Rica ederiz.

Bu arada, UserForm'a simge durumuna küçültecek düğmenin eklenmesini aşağıdaki kodlarla yapabilirsiniz.

Kod:
Private Declare Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 Sub UserForm_Activate()
    Dim hWnd As Long, exLong As Long
    hWnd = FindWindowA(vbNullString, Me.Caption)
    exLong = GetWindowLongA(hWnd, -16)
    If (exLong And &H20000) = 0 Then
        SetWindowLongA hWnd, -16, exLong Or &H20000
        Me.Hide
        Me.Show
    End If
End Sub
hocam simge durumuna küçült seçeneği geliyor ama simge durumuna küçülttüğümüzde windows bar üzerine simge yapmıyor, masaüstünün bir köşesine yerleştiriyor. diğer programlarda olduğu gibi windows bar üzerinde nasıl gösterebiliriz ??
 
Katılım
2 Haziran 2006
Mesajlar
111
hocam işime yaradı teşekkürler, fakat add icon kodundaki resmin yolunu belirtemediğim için icon ekleyemedim. bu konuda yardımcı olursanız sevinirim.

Private Sub AddIcon()
Dim hWnd As Long
Dim lngRet As Long
Dim hIcon As Long
hIcon = Sayfa1.Image1.Picture.Handle
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

bu kodda hata alıyorum

hIcon = Sayfa1.Image1.Picture.Handle

kısmını nasıl değiştirmeliyim.

Sayfamın adı KURLAR,
Resmimin adı Logo,

bunları yazdığımda hata alıyorum
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,083
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Normal resmi formunuza ekleyemezsiniz. Sayfanıza "IMAGE" nesnesi ekleyip resminizi image nesnesine yüklemeniz gerekiyor.

Image nesnesi eklemek için "DENETİM ARAÇ KUTUSU" menüsünü aktif hale getirin. 2003 versiyon için menüler üzerinde sağ klik yaparak ulaşabilirsiniz.
Bu menü çubuğunda büyük bir A harfi göreceksiniz. Hemen bu harfin yanındaki "GÖRÜNTÜ" seçeneğine tıklayın ve mouse yardımı ile sayfaya ekleyin. Sonra nesne üzerinde sağ klik yapın ve özellikler bölümünden "PICTURE" bölümünden resminizi tanımlayın.

Bu şekilde resminizi formunuza ekleyebilirsiniz...
 
Katılım
2 Haziran 2006
Mesajlar
111
hocam 2010 kullanıyorum ve şöyle yaptım,
geliştirici sekmesinden ekle dedim oradan activex denetimlerinden image ekledim sonra bu image a bir ikon ekledim. kod kısmında da bağlantıları düzenledim. oldu ama userform üzerinde icon gözüküyor. taskbar üstünde icon gözükmüyor. excel hata buldum onarıyorum diye bir uyarı verdi. onar dedim oldu. şu an sadece user form üzerinde icon gözüküyor. taskbar üstünde gözükmüyor, ne yapalım olduğu kadar :)
Yardımın için ayrıca teşekkür ederim
 
Katılım
3 Ekim 2013
Mesajlar
39
Excel Vers. ve Dili
Excel 2007 Türkçe
Bu arada, UserForm'a simge durumuna küçültecek düğmenin eklenmesini aşağıdaki kodlarla yapabilirsiniz.

Kod:
Private Declare Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 Sub UserForm_Activate()
    Dim hWnd As Long, exLong As Long
    hWnd = FindWindowA(vbNullString, Me.Caption)
    exLong = GetWindowLongA(hWnd, -16)
    If (exLong And &H20000) = 0 Then
        SetWindowLongA hWnd, -16, exLong Or &H20000
        Me.Hide
        Me.Show
    End If
End Sub



Haluk beyin koduna ilave formun tam ekran olması
Kod:
'FORMUN TAM EKRAN NORMAL EKRAN VE ALTA SİMGE DURUMUNDA KÜÇÜLTÜLMESİNİ SAÃ�LAR
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
'YUKARDAKİ İLE BİR (TAM EKRAN NORMAL EKRAN)
Private Sub UserForm_Activate()
  Dim hWndForm As Long, frmStyle As Long
  hWndForm = FindWindow(vbNullString, Me.Caption)
  frmStyle = GetWindowLong(hWndForm, (-16))
  frmStyle = frmStyle Or &H80000 Or &H20000 Or &H10000
  SetWindowLong hWndForm, (-16), frmStyle
  ShowWindow hWndForm, 5
  DrawMenuBar hWndForm
End Sub

Teşekkürler. Elinize sağlık şahane oldu.
 

emrebengul

Altın Üye
Katılım
5 Aralık 2015
Mesajlar
298
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2019 TR 32 Bit
Altın Üyelik Bitiş Tarihi
03-01-2028
Merhaba, userformu simge durumuna küçültme olayını ben de uygulamak istiyorum ancak kodları yapıştırdığım alan kırmızı yazı halini alıyor. nereye yapıştırmam gerektiğini de tam anlayamadım.

örnek dosyayı indirmek istedim sanırım o da kaldırılmış.

Yardımcı olabilir misiniz?
 

emrebengul

Altın Üye
Katılım
5 Aralık 2015
Mesajlar
298
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2019 TR 32 Bit
Altın Üyelik Bitiş Tarihi
03-01-2028
anladığım kadarıyla 64 bit işlemciyle alakalı bir durum.

çünkü kodlarda 32 bit üzerinden gidiyor olay. 32 yi 64 yapınca da birşey değişmiyor kodlar yine kırmızı renkte
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,083
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

11 nolu mesajımdaki ilk linke tıklayın. Açılan başlıkta 8 nolu mesajımdaki dosya linki çalışıyor. 64 bit versiyona göre düzenlenmiştir.
 
Katılım
16 Mart 2018
Mesajlar
30
Excel Vers. ve Dili
excel 2010
iyi günler. bu kodu daha önce ben de denemiştim ve çalışmıştı. fakat 64 bit için simge küçültme kodu bulamıyorum. bir fikriniz var mı ?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,083
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
11 nolu mesajımdaki ilk bağlantıda 64 bit sistemde çalışacak şekilde düzenlenmiş kodlar mevcut. İnceleyiniz.
 
Üst