Fonksiyon Tuşları Yardım

E

efeksk

Katılım
13 Nisan 2008
Mesajlar
205
Excel Vers. ve Dili
Excel 2003
Altın Üyelik Bitiş Tarihi
10/05/2019
Arkadaşlar Projemde Fonksiyon tuşları ile işlev yaptırmak istiyorum.

Fakat aşağıda kullandığım kodlar ile ilgili şöyle bir sorunum var...

Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 113 Then 'F2 Butonuna Basınca Formu Kapatır
Unload Me
End If
End Sub
Genişletmek için tıkla ...
Bu kodu normal üzerinde hiçbir nesne olmayan ve içinde başka bir kod olmayan boş bir Form'a uyguladığımda sorunsuz çalışıyor. Fakat Form'a TextBox, Label, CommandButton, Listviewv gibi nesneleri atayınca kodlar hiçbir şekilde çalışmıyor. Bana yardımcı olun lütfen
 
H

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,761
Excel Vers. ve Dili
Excel 2019 Türkçe
Bu kodlar UserForm_KeyDown olayına aittir. Eğer siz diğer nesneler için de keydown olayını kullanmak istiyorsanız; herbiri için, bu kodu yazmalısınız.
 
E

efeksk

Katılım
13 Nisan 2008
Mesajlar
205
Excel Vers. ve Dili
Excel 2003
Altın Üyelik Bitiş Tarihi
10/05/2019
hayır hamitcan arkadaşım. benim sorunum nesne eklenmiş bir userformu KeyDown olayı ile ESC tuşuna basarak kapatmaya çalışmak. Ama bu bi türlü olmuyor. Ben diğer nesneler için herhangi bir tuş atamıyacağım zaten
 
E

efeksk

Katılım
13 Nisan 2008
Mesajlar
205
Excel Vers. ve Dili
Excel 2003
Altın Üyelik Bitiş Tarihi
10/05/2019
Ok sorun anlaşıldı
benim kullanmaya çalıştığım kod, sadece Userform tabanında çalışıyormuş. Örneğin bir TextBox'ın içine girdiğimizde veya bir ListBox'a focuslanılmışsak çalışmazmış.

Şimdi sorun bunu ne şekilde halledicez :D
 
H

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,761
Excel Vers. ve Dili
Excel 2019 Türkçe
Kastetdiğim olay aşağıdaki gibiydi. Yani her nesnenin keydown olayına aşağıdaki kodu yazmalısınız.
Kod: 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 113 Then 'F2 Butonuna Basınca Formu Kapatır
    Unload Me
    End If
End Sub
 
E

efeksk

Katılım
13 Nisan 2008
Mesajlar
205
Excel Vers. ve Dili
Excel 2003
Altın Üyelik Bitiş Tarihi
10/05/2019
Ayvayı yeriz Hamitcan Kardeş :)
Zira bi hayli kalabalık zaten kod grubu

Örnekte olduğu gibi
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 Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
Dim hWnd As Long, lngRet As Long, hIcon As Long, WStyle As Long, Result As Long




Private Sub CommandButton14_Click()
iadearac.Show
End Sub
Private Sub CommandButton15_Click()
UserForm1.Hide
Application.Visible = True
Sheets("beton").Select
Range("A4").Select
End Sub



Private Sub CommandButton16_Click()
firma.Show
End Sub

Private Sub CommandButton17_Click()
cinsi.Show
End Sub

Private Sub CommandButton18_Click()
UserForm2.Show
End Sub


Private Sub CommandButton19_Click()
Dim pir
pir = MsgBox("Sayın " & Application.UserName & Chr(10) & Chr(10) & _
"Beton Takip v.12.3" & Chr(10) & Chr(10) & _
"Yapımcı: Halim KARAPINAR" & Chr(10) & Chr(10) & _
"İyi günler diler..." & Chr(10) & Chr(10) & _
"Dosya Kaydedilsin mi?", vbQuestion + vbYesNoCancel, "Çıkış")
Select Case pir
Case vbYes
ActiveWorkbook.Save
Unload Me
ActiveWorkbook.Close
Case vbNo
Application.DisplayAlerts = False
Unload Me
ActiveWorkbook.Close
End Select
End Sub

Private Sub Label1_Click()

End Sub

Private Sub TextBox8_Change()
If Len(TextBox8.Text) >= 8 Then TextBox8 = Left(TextBox8, 8)
If Len(TextBox8.Text) < 8 Then
TextBox8 = Replace(TextBox8, " ", "")
Else
TextBox8.Text = Format(TextBox8, "#####,#")
End If
End Sub



Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim pir
pir = MsgBox("Sayın " & Application.UserName & Chr(10) & Chr(10) & _
"Beton Takip v.12.3" & Chr(10) & Chr(10) & _
"Yapımcı: Halim KARAPINAR" & Chr(10) & Chr(10) & _
"İyi günler diler..." & Chr(10) & Chr(10) & _
"Dosya Kaydedilsin mi?", vbQuestion + vbYesNoCancel, "Çıkış")
Select Case pir
Case vbYes
ActiveWorkbook.Save
Unload Me
ActiveWorkbook.Close
Case vbNo
Application.DisplayAlerts = False
Unload Me
ActiveWorkbook.Close
End Select
End Sub
Private Sub CommandButton1_Click()
Dim TheMax As Double
Sheets("beton").Select
TheMax = WorksheetFunction.Max(Range("A1:A65536"))
TextBox10.Text = TheMax + 1
'K A Y D E T
Set s1 = Sheets("beton")
A = s1.[A65536].End(3).Row + 1
s1.Cells(A, "b") = TextBox1.Text
s1.Cells(A, "c") = TextBox2.Text
s1.Cells(A, "d") = TextBox3.Text
s1.Cells(A, "e") = TextBox4.Value
s1.Cells(A, "f") = TextBox5.Text
s1.Cells(A, "a") = TextBox10.Text
'A&F sütun aralığını A3 hücresi baz alınarak sıralatıyoruz
Range("A3:F65536").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ListView1.ListItems.Clear

TextBox8.Value = WorksheetFunction.Sum(s1.Range("E3:E" & A))

'Kolanlara yenilenen verileri al
c = WorksheetFunction.CountA(ActiveSheet.Range("A:A"))
With ListView1
For i = 2 To c
x = x + 1
.ListItems.Add , , Cells(i + 1, 1)
.ListItems(x).SubItems(1) = Cells(i + 1, 2)
.ListItems(x).SubItems(2) = Cells(i + 1, 3)
.ListItems(x).SubItems(3) = Cells(i + 1, 4)
.ListItems(x).SubItems(4) = Format(Cells(i + 1, 5), "#,##0.00")
.ListItems(x).SubItems(5) = Cells(i + 1, 6)
.ListItems(x).SubItems(6) = Cells(i + 1, 7)
'eğer hücre başında (*) işareti var ise satırı mavi renklendir
If Left(Cells(i + 1, 2), 1) = "*" Then
.ListItems(x).ListSubItems(1).ForeColor = vbBlue
.ListItems(x).ForeColor = vbBlue
End If
'eğer hücre başında :)) işareti var ise satırı kırmızı renklendir
If Left(Cells(i + 1, 2), 1) = ":" Then
.ListItems(x).ListSubItems(1).ForeColor = vbYellow
.ListItems(x).ForeColor = vbYellow
End If
Next
End With
ListView1.FullRowSelect = True
ListView1.Gridlines = True
MsgBox " Tarih = " & TextBox1 & Chr(10) & " Döküm Yeri = " _
& TextBox2, vbInformation, "KAYIT BİLGİLERİ"


Sheets("beton").Select
TheMax = WorksheetFunction.Max(Range("A1:A65536"))
TextBox10.Text = TheMax + 1

sayı = c - 1 'başlık olan hücre adedini düşüyoruz
Label1 = sayı & " ADET KAYIT BULUNMAKTA "
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox1.SetFocus

End Sub
Private Sub CommandButton13_Click()
For i = 1 To [f65536].End(3).Row
If Cells(i, "f") <> "" Then
SnDlSt = Cells(i, "f").Row
End If
Next i
Sheets("beton").Range("a1:f" & SnDlSt).PrintOut
End Sub
Private Sub CommandButton2_Click()
'D E Ğ İ Ş T İ R
On Error Resume Next
If TextBox1.Text = "" Then
MsgBox "LÜTFEN ÖNCE LİSTEDEN BİR SEÇİM YAPIN", vbCritical, "D İ K K A T"
ListView1.SetFocus
Exit Sub
End If
On Error Resume Next
If TextBox1.Text = "" Then
MsgBox ("LÜTFEN TARİH GİRİN"), vbCritical, ("TARİH BÖLÜMÜ BOŞ")
TextBox1.SetFocus
Exit Sub
ElseIf TextBox2.Text = "" Then
MsgBox ("LÜTFEN DÖKÜM YERİNİ GİRİN"), vbCritical, ("DÖÜM YERİ BÖLÜMÜ BOŞ")
TextBox2.SetFocus
Exit Sub
ElseIf TextBox3.Text = "" Then
MsgBox ("LÜTFEN BETON MİKTARINI GİRİN"), vbCritical, ("BETON MİKTARI BÖLÜMÜ BOŞ")
TextBox3.SetFocus
Exit Sub
ElseIf TextBox4.Text = "" Then
MsgBox ("LÜTFEN BRM FİYAT BÖLÜMÜNÜ GİRİN"), vbCritical, ("BR FİYAT BÖLÜMÜ BOŞ")
TextBox4.SetFocus
Exit Sub
End If
Sheets("beton").Select
Set s1 = Sheets("beton")
Dim sat%
On Error GoTo hata
Cevap = MsgBox("DEĞİŞTİRMEK İSTEDİĞİNİZDEN EMİNMİSİNİZ ?", vbYesNo, "DEĞİŞTİRME ONAYI")
If Cevap = vbNo Then
For tem = 1 To 7
Controls("textbox" & tem) = Empty
Next
TextBox1.Enabled = True
TextBox1.SetFocus
Exit Sub
End If
If Cevap = vbYes Then
[a1:a65536].Find(TextBox1.Text, LookAt:=xlWhole).Select
For i = 2 To 7
ActiveCell(1, i).Value = Controls("textbox" & i).Value
Next
MsgBox "VERİNİZ DEĞİŞTİRİLDİ", vbInformation, "YENİLEME"
End If
'A&F sütun aralığını A3 hücresi baz alınarak sıralatıyoruz
Range("A3:F65536").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ListView1.ListItems.Clear
'Kolanlara yenilenen verileri tekrar al
c = WorksheetFunction.CountA(ActiveSheet.Range("A:A"))
With ListView1
For i = 2 To c
x = x + 1
.ListItems.Add , , Cells(i + 1, 1)
.ListItems(x).SubItems(1) = Cells(i + 1, 2)
.ListItems(x).SubItems(2) = Cells(i + 1, 3)
.ListItems(x).SubItems(3) = Cells(i + 1, 4)
.ListItems(x).SubItems(4) = Format(Cells(i + 1, 5), "#,##0.00")
.ListItems(x).SubItems(5) = Cells(i + 1, 6)
.ListItems(x).SubItems(6) = Cells(i + 1, 7)
'eğer hücre başında (*) işareti var ise satırı mavi renklendir
If Left(Cells(i + 1, 2), 1) = "*" Then
.ListItems(x).ListSubItems(1).ForeColor = vbBlue
.ListItems(x).ForeColor = vbBlue
End If
'eğer hücre başında :)) işareti var ise satırı kırmızı renklendir
If Left(Cells(i + 1, 2), 1) = ":" Then
.ListItems(x).ListSubItems(1).ForeColor = vbYellow
.ListItems(x).ForeColor = vbYellow
End If
Next
End With
ListView1.FullRowSelect = True
ListView1.Gridlines = True
MsgBox " Tarih = " & TextBox1 & Chr(10) & " Döküm Yeri = " _
& TextBox2, vbInformation, "DEĞİŞTİRME BİLGİLERİ"
sayı = c - 1
Label1 = sayı & " ADET KAYIT BULUNMAKTA"
'SON KAYDEDİLEN VERİNİN OLDUĞU SATIRA GİDER..LİSTVİEWDE
Dim lvwItm As ListItem
Set lvwItm = ListView1.FindItem(TextBox1.Text, , , lvwPartial)
n = lvwItm.Index
ListView1.ListItems(n).Selected = True
ListView1.SelectedItem.EnsureVisible
ListView1.DropHighlight = ListView1.ListItems(n)
'------------------------------------------------------------
For tem = 1 To 7
Controls("textbox" & tem) = Empty
Next
TextBox1.Enabled = True
CommandButton1.Enabled = True
CommandButton4.Enabled = False
TextBox1.SetFocus

hata:
End Sub
Private Sub CommandButton3_Click()
'S İ L
On Error Resume Next
If TextBox1.Text = "" Then
MsgBox "LÜTFEN ÖNCE LİSTEDEN BİR SEÇİM YAPIN", vbCritical, "D İ K K A T"
ListView1.SetFocus
Exit Sub
End If
Sheets("beton").Select
Set s1 = Sheets("beton")
Dim sat%
On Error GoTo hata
Cevap = MsgBox("SİLMEK İSTEDİĞİNİZDEN EMİNMİSİNİZ ?", vbYesNo, "SİLME ONAYI")
If Cevap = vbNo Then
For tem = 1 To 7
Controls("textbox" & tem) = Empty
Next
TextBox1.Enabled = True
TextBox1.SetFocus
Exit Sub
End If
If Cevap = vbYes Then
[a1:a65536].Find(TextBox1.Text, LookAt:=xlWhole).Select
ActiveCell.EntireRow.Delete
MsgBox "VERİNİZ SİLİNDİ", vbInformation, "S İ L"
End If
'A&F sütun aralığını A3 hücresi baz alınarak sıralatıyoruz
Range("A3:F65536").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ListView1.ListItems.Clear
'Kolanlara yenilenen verileri tekrar al
c = WorksheetFunction.CountA(ActiveSheet.Range("A:A"))
With ListView1
For i = 2 To c
x = x + 1
.ListItems.Add , , Cells(i + 1, 1)
.ListItems(x).SubItems(1) = Cells(i + 1, 2)
.ListItems(x).SubItems(2) = Cells(i + 1, 3)
.ListItems(x).SubItems(3) = Cells(i + 1, 4)
.ListItems(x).SubItems(4) = Format(Cells(i + 1, 5), "#,##0.00")
.ListItems(x).SubItems(5) = Cells(i + 1, 6)
.ListItems(x).SubItems(6) = Cells(i + 1, 7)
'eğer hücre başında (*) işareti var ise satırı mavi renklendir
If Left(Cells(i + 1, 2), 1) = "*" Then
.ListItems(x).ListSubItems(1).ForeColor = vbBlue
.ListItems(x).ForeColor = vbBlue
End If
'eğer hücre başında :)) işareti var ise satırı kırmızı renklendir
If Left(Cells(i + 1, 2), 1) = ":" Then
.ListItems(x).ListSubItems(1).ForeColor = vbYellow
.ListItems(x).ForeColor = vbYellow
End If
Next
End With
ListView1.FullRowSelect = True
ListView1.Gridlines = True
sayı = c - 1
Label1 = sayı & " ADET KAYIT BULUNMAKTA"
For tem = 1 To 7
Controls("textbox" & tem) = Empty
Next
TextBox1.Enabled = True
CommandButton1.Enabled = True
CommandButton4.Enabled = False
TextBox1.SetFocus

hata:
End Sub
Private Sub CommandButton4_Click()
'T E M İ Z L E
TextBox1.Enabled = True
CommandButton1.Enabled = True
CommandButton2.Enabled = False
CommandButton3.Enabled = False
For tem = 1 To 7
Controls("textbox" & tem) = Empty
Next
TextBox1.SetFocus
CommandButton4.Enabled = False
CommandButton6.Enabled = False
End Sub

Private Sub ListView1_DblClick()
TextBox10.Enabled = False
CommandButton1.Enabled = False
x = ListView1.SelectedItem.Index
TextBox10.Text = ListView1.ListItems(x)
TextBox1.Text = ListView1.ListItems(x).ListSubItems(1).Text
TextBox2.Text = ListView1.ListItems(x).ListSubItems(2).Text
TextBox3.Text = ListView1.ListItems(x).ListSubItems(3).Text
TextBox4.Text = ListView1.ListItems(x).ListSubItems(4).Text
TextBox5.Text = ListView1.ListItems(x).ListSubItems(5).Text
TextBox6.Text = ListView1.ListItems(x).ListSubItems(6).Text
On Error Resume Next
If Left(TextBox2.Text, 1) = "*" Or Left(TextBox2.Text, 1) = "-" Then
MsgBox ("TARİHİ SİLEMEZ VE DEĞİŞTİREMEZSİNİZ"), vbCritical, ("DİKKAT")
For tem = 1 To 7
Controls("textbox" & tem) = Empty
Next
TextBox10.Enabled = True
CommandButton1.Enabled = True
Exit Sub
End If
CommandButton2.Enabled = True
CommandButton3.Enabled = True
CommandButton4.Enabled = True
CommandButton6.Enabled = True
End Sub
Private Sub ListView1_KeyUp(KeyCode As Integer, ByVal Shift As Integer)
TextBox10.Enabled = False
CommandButton1.Enabled = False
x = ListView1.SelectedItem.Index
TextBox10.Text = ListView1.ListItems(x)
TextBox1.Text = ListView1.ListItems(x).ListSubItems(1).Text
TextBox2.Text = ListView1.ListItems(x).ListSubItems(2).Text
TextBox3.Text = ListView1.ListItems(x).ListSubItems(3).Text
TextBox4.Text = ListView1.ListItems(x).ListSubItems(4).Text
TextBox5.Text = ListView1.ListItems(x).ListSubItems(5).Text
TextBox6.Text = ListView1.ListItems(x).ListSubItems(6).Text
On Error Resume Next
If Left(TextBox2.Text, 1) = "*" Or Left(TextBox2.Text, 1) = "-" Then
For tem = 1 To 7
Controls("textbox" & tem) = Empty
Next
TextBox10.Enabled = True
CommandButton1.Enabled = True
Exit Sub
End If
CommandButton2.Enabled = True
CommandButton3.Enabled = True
CommandButton4.Enabled = True
CommandButton6.Enabled = True
End Sub
Private Sub ListView2_Click()
OptionButton1.Value = True
x = ListView2.SelectedItem.Index
TextBox7.Text = ListView2.ListItems(x)
TextBox1.Enabled = True
ListView2.SetFocus
CommandButton4.Enabled = True
For tem = 1 To 7
Controls("textbox" & tem) = Empty
Next
End Sub
Private Sub OptionButton1_Click()
TextBox7.SetFocus
End Sub
Private Sub OptionButton2_Click()
TextBox7.SetFocus
End Sub
Private Sub OptionButton3_Click()
TextBox7.SetFocus
End Sub

Private Sub UserForm_Initialize()
CommandButton19.Cancel = True

Sheets("beton").Select
Dim i As Integer
ListView1.View = lvwReport
'Kolanlara isim ver
With ListView1.ColumnHeaders
.Add , , "Sıra No", 40 ' Burda ..... sütun genişliği
.Add , , "Tarih", 60, lvwColumnCenter
.Add , , "Döküm yeri", 253, lvwColumnLeft
.Add , , "Sınıfı", 50, lvwColumnCenter
.Add , , "Miktarı", 50, lvwColumnLeft
.Add , , "Birimi", 40, lvwColumnCenter
.Add , , "Birimi", 1, lvwColumnCenter
End With
'Kolanlara verileri al
c = WorksheetFunction.CountA(ActiveSheet.Range("A:A"))
With ListView1
For i = 2 To c
x = x + 1
.ListItems.Add , , Cells(i + 1, 1)
.ListItems(x).SubItems(1) = Cells(i + 1, 2)
.ListItems(x).SubItems(2) = Cells(i + 1, 3)
.ListItems(x).SubItems(3) = Cells(i + 1, 4)
.ListItems(x).SubItems(4) = Format(Cells(i + 1, 5), "#,##0.00")
.ListItems(x).SubItems(5) = Cells(i + 1, 6)
.ListItems(x).SubItems(6) = Cells(i + 1, 7)
'eğer hücre başında (*) işareti var ise satırı mavi renklendir
If Left(Cells(i + 1, 2), 1) = "*" Then
.ListItems(x).ListSubItems(1).ForeColor = vbBlue
.ListItems(x).ForeColor = vbBlue
End If
'eğer hücre başında :)) işareti var ise satırı kırmızı renklendir
If Left(Cells(i + 1, 2), 1) = ":" Then
.ListItems(x).ListSubItems(1).ForeColor = vbYellow
.ListItems(x).ForeColor = vbYellow
End If
Next
End With
ListView1.FullRowSelect = True
ListView1.Gridlines = True
'rayiç adedini bulmak için
sayı = c - 1
Label1 = sayı & " ADET KAYIT BULUNMAKTA"


'TOPLAM TUTAR
Set s1 = Sheets("beton")
A = s1.[A65536].End(3).Row + 1
TextBox8.Value = WorksheetFunction.Sum(s1.Range("E3:E" & A))
End Sub

Private Sub ComboBox2_Click()
TextBox5.Text = ComboBox2.Value
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Format(TextBox1, "dd.mm.yyyy")
End Sub
Private Sub UserForm_Activate()
TextBox10.Enabled = False
Dim TheMax As Double
Sheets("beton").Select
TheMax = WorksheetFunction.Max(Range("A1:A65536"))
TextBox10.Text = TheMax + 1

'Tab Tuşu İçin TextBox, ComboBox ve CommandButton'lara Sıra vermek
TextBox1.TabIndex = 1
TextBox2.TabIndex = 2
CommandButton16.TabIndex = 3
TextBox3.TabIndex = 4
CommandButton17.TabIndex = 5
TextBox4.TabIndex = 6
CommandButton1.TabIndex = 7


IconEkle
KucultButonuEkle
GorevCubugundaGoster Me
Application.Visible = False
End Sub

Private Sub IconEkle()
hIcon = UserForm1.Image5.Picture.Handle ' userform üzerindeki resimden icon alıyor, resim yolunu değiştirebilirsiniz
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 KucultButonuEkle()
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 GorevCubugundaGoster(myForm)
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
Genişletmek için tıkla ...
 
H

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,761
Excel Vers. ve Dili
Excel 2019 Türkçe
Nesne sayısı fazla olduğu için bir class module içine bu kod gömülebilir.
 
E

efeksk

Katılım
13 Nisan 2008
Mesajlar
205
Excel Vers. ve Dili
Excel 2003
Altın Üyelik Bitiş Tarihi
10/05/2019
Sanırım haklısın
Yahut hepsini bırakıp formun kendi nimetlerinden yararlanarak Accelerator Özelliğinden Herhangi bir harf atayarak Alt+ Kombinasyonu oluşturmak. Oda birşeydir. Şimdi Tonla nesneye tek tek ClassModüle İçinde Kod yaz dur. Ufffff :(
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst