[Tarkan VURAL]

UserForm üzerindeki başlık çubuğuna eklenen resimden formu kapatma şansınız da oluyor.

Kod: Tümünü seç

Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd 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 SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

Kod: Tümünü seç

Private Sub UserForm_Initialize()
    Dim hWnd As Long
    Dim lngRet As Long
    Dim hIcon As Long
    hIcon = UserForm1.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

Yalnız formu kapattıktan sonra I/O error veriyor nedenini çözümleyemedim.
Örnek dosyayı da ekliyorum.

[Soner ŞENOL]

Hocam bu çalışma da ilk açılışta uyarı veriyor

[Erhan Yavuz]

Auto_Open ile UserForm açıp, sol üsteki icondan kapattım. Gayet de güzel çalıştı. Hatta taşıma olanağı bile verdi...

[mustim1547]

Bunda Userform yok ki.. !!!

[Murat OSMA]

Bunda Userform yok ki.. !!!

UserForm orada var, çalıştırmak için sayfaya buton ekleyip, Alt+F11 tuşuna basın. Kod penceresi açılacak.
Hemen solda Sayfa 1 var oraya çift tıklayın. Sayfa 1'in kod penceresi açılacak, buraya aşağıdaki kodu yazın.

Kod: Tümünü seç

Sub EVN ()
ExcelVBANet.Show
End Sub

Sonra çalışma sayfasına dönüp, eklediğiniz butona sağ tıklayın, makro atayı seçip açılan pencereden EVN yi seçin ve ENTER'a basın.

Şimdi butona bastığınızda UserForm'un orada olduğunu göreceksiniz...

[Murat OSMA]

Alternatif bir örnek eklemek istiyorum.

Kod: Tümünü seç

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 SendMessage Lib "user32" Alias _
      "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
      ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal _
      hWnd As Long) As Long
Private wHandle As Long

Kod: Tümünü seç

Private Sub UserForm_Initialize()
    On Error Resume Next
    Me.Caption = "ExcelVBA.Net"
    Image1.Visible = False
    If Val(Application.Version) >= 9 Then
        wHandle = FindWindow("ThunderDFrame", Me.Caption)
    Else
        wHandle = FindWindow("ThunderXFrame", Me.Caption)
    End If
    If wHandle = 0 Then Exit Sub
    hIcon = Image1.Picture
    SendMessage wHandle, &H80, True, hIcon
    SendMessage wHandle, &H80, False, hIcon
    frm = GetWindowLong(wHandle, -20)
    frm = frm And Not &H1
    SetWindowLong wHandle, -20, frm
    DrawMenuBar wHandle
End Sub


[acahan]

bU USER FORMDA YER ALAN KODLAR BU kodların arasına aşağıdaki KOD-1 VE KOD2 kodlarını nasıl ekleyebilirim.

Kod: Tümünü seç

'Www.ExcelVBA.Net
Private Sub ComboBox1_Change()
TextBox1 = epmpty: TextBox2 = Empty: TextBox3 = Empty: TextBox4 = Empty
Label5.Visible = False
End Sub

Private Sub CommandButton1_Click()
If TextBox1.Text <> Empty And TextBox2.Text <> Empty And TextBox4.Text <> Empty And _
        ComboBox1.Text <> Empty Then
TextBox3 = Sayfa1.Range("a65536").End(3).Value + 1
Else
    MsgBox "Eksik bilgi girilmiş", vbExclamation, "Www.ExcelVBA.Net"
    CommandButton2_Click
        Exit Sub
End If
With Sayfa1
For Each bul In Sayfa1.Range("b2:b" & Range("b65536").End(3).Row)
    If bul = ComboBox1 Then
    Label5.Visible = True
        Exit Sub
    End If
Next bul
For Each bul In .Range("b2:b" & Range("b65536").End(3).Row)
    If bul = ComboBox1 Then
        bul.Offset(i, -1).Activate
        bul.Offset(i, 1) = TextBox1
        bul.Offset(i, 2) = TextBox2
        bul.Offset(i, -1) = TextBox3
        bul.Offset(i, 3) = TextBox4
        bul.Offset(i, 4) = TextBox5
        UserForm_Initialize
        Exit For
    Else
        .Range("a65536").End(3).Offset(1, 0) = .Range("a65536").End(3) + 1
        .Range("a65536").End(3).Offset(0, 1) = ComboBox1
        .Range("a65536").End(3).Offset(0, 2) = TextBox1
        .Range("a65536").End(3).Offset(0, 3) = TextBox2
        .Range("a65536").End(3).Offset(0, 4) = TextBox4
        .Range("a65536").End(3).Offset(0, 5) = TextBox5
        UserForm_Initialize
        Exit For
    End If
Next bul
End With
End Sub

Private Sub CommandButton2_Click()
Dim bul As Range
For Each bul In Sayfa1.Range("b2:b" & Range("b65536").End(3).Row)
    If bul = ComboBox1 Then
        bul.Offset(i, -1).Activate
        TextBox1 = bul.Offset(i, 1)
        TextBox2 = bul.Offset(i, 2)
        TextBox3 = bul.Offset(i, -1)
        TextBox4 = bul.Offset(i, 3)
        TextBox5 = bul.Offset(i, 4)
    Else
        TextBox3 = Sayfa1.Range("a65536").End(3).Value + 1
    End If
Next bul
End Sub

Private Sub CommandButton3_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim i As Byte
ComboBox1.Clear
For i = 2 To [a65536].End(3).Row
ComboBox1.AddItem Cells(i, 2)
Next i
End Sub


KODLAR


KOD1

Kod: Tümünü seç

Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd 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 SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&


KOD-2

Kod: Tümünü seç

Private Sub UserForm_Initialize()
    Dim hWnd As Long
    Dim lngRet As Long
    Dim hIcon As Long
    hIcon = UserForm1.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

[Tarkan VURAL]

Kurallara göre yazmayanlara yanıt vermiyoruz.

[Ozan İLGÜN]

Kod: Tümünü seç

    hIcon = Image1.Picture
   

Kod: Tümünü seç

hIcon = 5 uyarı işareti
  hIcon = 7 soru işareti
  hIcon = 9 kritik hata işareti
hIcon = 11 info bulutu işareti
hIcon = 17 ok işareti
hIcon = 19 işareti gizle
hIcon = 25 yukarı siyah ok işareti
hIcon = 27 boyutlandırma işareti
hIcon = 555 çarpı işareti
hIcon = 587 yardım işareti
hIcon = 585 TR işareti


Murat Bey verdiğiniz kod gerçekten çok güzel çalışıyor. Teşekkürler. İconu değiştirmek isteyenler için yukarıdakileri yazayım dedim. İconların tam listesi system32 klasöründe bir dosyanın içindeydi ama hatırlayamadım dosyayı sadece bunları bulabildim. Ayrıca Tarkan Bey'in eklediği dosyayı açtığımda bende boş çıktı. Güvenlik olaylarından dolayı olma ihtimali varmıdır. İyi günler

[Tarkan VURAL]

Tarkan Bey'in eklediği dosyayı açtığımda bende boş çıktı.

Yeni dosya hazırlayıp ilk mesaja yükledim.

[Ozan İLGÜN]

Yeni dosya hazırlayıp ilk mesaja yükledim

Olağanüstü olmuş. Paylaşım için