Userforma Minimize, maksimize ve icon ekleyen kodlarda ikonu dosyadan alma

[hsayar]

Option Explicit
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&

Private Sub UserForm_Activate()
    Dim hWnd As Long
    hWnd = FindWindow(vbNullString, Me.Caption)
    SetWindowLong hWnd, -16, GetWindowLong(hWnd, -16) Or &H10000 _
    Or &H20000 Or &H40000
    'AddIcon
    Call AddMinimiseButton
    AppTasklist Me
End Sub

'Private Sub AddIcon()
'    Dim hWnd As Long
'    Dim lngRet As Long
'    Dim hIcon As Long
[B]'    hIcon = Sayfa1.Image1.Picture.Handle[/B]'    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 AddMinimiseButton()
    Dim hWnd As Long
    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 AppTasklist(myForm)
    Dim WStyle As Long
    Dim Result As Long
    Dim hWnd As Long
    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


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Application.Visible = True
End Sub

forumdan indirdiğim
Tam Ekran + Minimize + TaskBar + Resize User Form %F6rne%F0i.rar
dosyasında yer alan yukardaki kodlarda sayfa1 den al dediğimiz resmi kendi sayfa1 miz den nasıl revize edeceğiz veya Thisworkbook.path altında yer lana ayrı bir resim dosyasını nasıl ekleyeceğiz.

 

[Zeki Gürsoy]

Bence form üzerinde gizli Image nesnesiyle alsın.

Private Sub AddIcon()
    Dim hWnd As Long
    Dim lngRet As Long
    Dim hIcon As Long
   [B]Image1.Picture = LoadPicture( _[/B]
[B]       ThisWorkbook.Path & "\Test.ico")[/B]
[B]   hIcon = Image1.Picture.Handle[/B]'    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

 

[hsayar]

teşekkür ederim hocam
arkadaşlar
Image1.Picture = LoadPicture( _
ThisWorkbook.Path & "\Test.ico")

parantezi kapatamayı arkadaşlar ilk etapta unutabilirler. bende geç farkettim.

 

[hsayar]

Sn hocalarım diyelimki aynı kitapta 4 tane userformumuz var herbirine bu kodları eklemek zorundamıyız?

 

[hsayar]

bir üst mesajdaki sorumu kısmaen çözdüm, sizinlede paylaşmak istedim;

MODULE

Option Explicit
Option Private Module
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetActiveWindow Lib "user32.dll" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public 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&

'============================================================================================================================|
'/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*|
Sub AddIcon(myRsm, MyForm As Object)                                                                                  '/*/*/*|
    Dim hWnd, lngRet, hIcon As Long                                                                                   '/*/*/*|
    hIcon = myRsm.Picture.Handle                                                                                      '/*/*/*|
    hWnd = FindWindow(vbNullString, MyForm.Caption)                                                                   '/*/*/*|
    lngRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)                                                   '/*/*/*|
    lngRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)                                                     '/*/*/*|
    lngRet = DrawMenuBar(hWnd)                                                                                        '/*/*/*|
End Sub                                                                                                               '/*/*/*|
Sub AddMinimiseButton()                                                                                               '/*/*/*|
    Dim hWnd_mnm As Long:    hWnd_mnm = GetActiveWindow                                                               '/*/*/*|
    Call SetWindowLong(hWnd_mnm, GWL_STYLE, GetWindowLong(hWnd_mnm, GWL_STYLE) Or WS_MINIMIZEBOX)                     '/*/*/*|
    Call SetWindowPos(hWnd_mnm, 0, 0, 0, 0, 0, SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE)                          '/*/*/*|
End Sub                                                                                                               '/*/*/*|
Sub AppTasklist(MyForm As Object)                                                                                     '/*/*/*|
    Dim WStyle, Result, hWnd As Long                                                                                  '/*/*/*|
    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                                                                                                               '/*/*/*|
'/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*|
'============================================================================================================================|

USERFORMLARA

Option Explicit
Private Sub UserForm_Activate()
    Dim hWnd As Long
    hWnd = FindWindow(vbNullString, Me.Caption)
    SetWindowLong hWnd, -16, GetWindowLong(hWnd, -16) Or &H10000 _
    Or &H20000 Or &H40000
    Me.Image1.Picture = LoadPicture(ThisWorkbook.Path & "\VideoOptions.ico"): Image1.Visible = True
    Call AddIcon(Me.[Color="Red"][B]Image1[/B][/Color], Me)
    Call AddMinimiseButton
    Call AppTasklist(Me)
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Application.Visible = True
End Sub

Call AddIcon(Me.Image1, Me)

Kırmızı yere iconun nereden alınacağını yazacaksınız. Me.Image1 Bu userformdaki image1 nesnesinden demek olduğu gibi Sayfa1.İmage1 şeklinde kullanımda mevcut ama ben beceremeiştim.


Şimdi sorum şu hocalarım

Sub AddIcon(myRsm, MyForm As Object)                                                                                  '/*/*/*|
    Dim hWnd, lngRet, hIcon As Long                                                                                   '/*/*/*|
    hIcon = myRsm.Picture.Handle                                                                                      '/*/*/*|
    hWnd = FindWindow(vbNullString, MyForm.Caption)                                                                   '/*/*/*|
    lngRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)                                                   '/*/*/*|
    lngRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)                                                     '/*/*/*|
    lngRet = DrawMenuBar(hWnd)                                                                                        '/*/*/*|
End Sub                                                                                                               '/*/*/*|

şeklinde Addİcon prosodorünü parametriğie çevirdik ve userformdan aşağıdaki şekilde çağırıyoruz.
Call AddIcon(Me.Image1, Me)

Peki Nesne adı belirtmek istemedik nesnemiz yok ve aşağıdaki gibi girdik.
Call AddIcon(, Me)

Prosodürde ne gibi bir değişiklik yapmalı ki Excel İconu Aynı zamanda userform ikonu olsun?