MsgBox Sayfanın Tam Ortasında Olmasın

Mesaj Kutusu. Programcıların olmazsa olmazlarından.

MsgBox Sayfanın Tam Ortasında Olmasın

İleti#1)  Haldun Alay » 05 Kas 2013 22:36

Merhabalar,

Internette ufak bir araştırma ile aşağıdaki koda ulaştım. Kodu bir modüle kopyalayıp FindMe makrosunu çalıştırın. Dikkat etmeniz gereken nokta makroyu VBA düzenleyicisi içerisinden değil, Excel penceresi aktif iken Alt-F8'e basarak çalıştırmanız.
Kod: Tümünü seç
Option Explicit

Type RECT
    Left       As Long
    Top        As Long
    Right      As Long
    Bottom     As Long
End Type

Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId 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 GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Const GWL_HINSTANCE = (-6)
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOACTIVATE = &H10
Public Const HCBT_ACTIVATE = 5
Public Const WH_CBT = 5
Public hHook   As Long
Public hXL     As Long

Function TopRight(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim rectXL As RECT, rectMsg As RECT
    Dim x As Long, y As Long
    Dim hMsgbox As Long
    If lMsg = HCBT_ACTIVATE Then
        hMsgbox = GetActiveWindow
        GetWindowRect hXL, rectXL
        GetWindowRect wParam, rectMsg
        x = (rectXL.Left + (rectXL.Right - rectXL.Left) * 0.9) - ((rectMsg.Right - rectMsg.Left) / 2)
        y = (rectXL.Top + (rectXL.Bottom - rectXL.Top) * 0.1) - ((rectMsg.Bottom - rectMsg.Top) / 2)
        SetWindowPos wParam, 0, x, y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
        UnhookWindowsHookEx hHook
    End If
    TopRight = False
End Function

Private Sub ShowMsgBoxTopRight()
    Dim hInst  As Long
    Dim Thread As Long
    hXL = FindWindow("XLMAIN", Application.Caption)
    hInst = GetWindowLong(hXL, GWL_HINSTANCE)
    Thread = GetCurrentThreadId()
    hHook = SetWindowsHookEx(WH_CBT, AddressOf TopRight, hInst, Thread)
    MsgBox "Wow, look at me up here !", , "Top right"
End Sub

Function BottomRight(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim rectXL As RECT, rectMsg As RECT
    Dim x As Long, y As Long
    Dim hMsgbox As Long
    If lMsg = HCBT_ACTIVATE Then
        hMsgbox = GetActiveWindow
        GetWindowRect hXL, rectXL
        GetWindowRect wParam, rectMsg
        x = (rectXL.Left + (rectXL.Right - rectXL.Left) * 0.9) - ((rectMsg.Right - rectMsg.Left) / 2)
        y = (rectXL.Top + (rectXL.Bottom - rectXL.Top) * 0.9) - ((rectMsg.Bottom - rectMsg.Top) / 2)
        SetWindowPos wParam, 0, x, y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
        UnhookWindowsHookEx hHook
    End If
    BottomRight = False
End Function

Private Sub ShowMsgBoxBottomRight()
    Dim hInst  As Long
    Dim Thread As Long
    hXL = FindWindow("XLMAIN", Application.Caption)
    hInst = GetWindowLong(hXL, GWL_HINSTANCE)
    Thread = GetCurrentThreadId()
    hHook = SetWindowsHookEx(WH_CBT, AddressOf BottomRight, hInst, Thread)
    MsgBox "Hey, look down here !", , "Bottom right"
End Sub


Function TopLeft(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim rectXL As RECT, rectMsg As RECT
    Dim x As Long, y As Long
    Dim hMsgbox As Long
    If lMsg = HCBT_ACTIVATE Then
        hMsgbox = GetActiveWindow
        GetWindowRect hXL, rectXL
        GetWindowRect wParam, rectMsg
        x = (rectXL.Left + (rectXL.Right - rectXL.Left) * 0.1) - ((rectMsg.Right - rectMsg.Left) / 2)
        y = (rectXL.Top + (rectXL.Bottom - rectXL.Top) * 0.1) - ((rectMsg.Bottom - rectMsg.Top) / 2)
        SetWindowPos wParam, 0, x, y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
        UnhookWindowsHookEx hHook
    End If
    TopLeft = False
End Function

Private Sub ShowMsgBoxTopLeft()
    Dim hInst  As Long
    Dim Thread As Long
    hXL = FindWindow("XLMAIN", Application.Caption)
    hInst = GetWindowLong(hXL, GWL_HINSTANCE)
    Thread = GetCurrentThreadId()
    hHook = SetWindowsHookEx(WH_CBT, AddressOf TopLeft, hInst, Thread)
    MsgBox "Now look up here !", , "Top left"
End Sub

Function BottomLeft(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim rectXL As RECT, rectMsg As RECT
    Dim x As Long, y As Long
    Dim hMsgbox As Long
    If lMsg = HCBT_ACTIVATE Then
        hMsgbox = GetActiveWindow
        GetWindowRect hXL, rectXL
        GetWindowRect wParam, rectMsg
        x = (rectXL.Left + (rectXL.Right - rectXL.Left) * 0.1) - ((rectMsg.Right - rectMsg.Left) / 2)
        y = (rectXL.Top + (rectXL.Bottom - rectXL.Top) * 0.9) - ((rectMsg.Bottom - rectMsg.Top) / 2)
        SetWindowPos wParam, 0, x, y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
        UnhookWindowsHookEx hHook
    End If
    BottomLeft = False
End Function

Private Sub ShowMsgBoxBottomLeft()
    Dim hInst  As Long
    Dim Thread As Long
    hXL = FindWindow("XLMAIN", Application.Caption)
    hInst = GetWindowLong(hXL, GWL_HINSTANCE)
    Thread = GetCurrentThreadId()
    hHook = SetWindowsHookEx(WH_CBT, AddressOf BottomLeft, hInst, Thread)
    MsgBox "Look down to the left !", , "Bottom left"
End Sub

Sub FindMe()
    Run "ShowMsgBoxTopRight"
    Run "ShowMsgBoxBottomRight"
    Run "ShowMsgBoxTopLeft"
    Run "ShowMsgBoxBottomLeft"
    MsgBox "Back in the center where I belong.", , "Home at last."
End Sub
Kullanıcı avatarı
Haldun Alay
Site Dostu
 
Adı Soyadı:Haldun Alay
Kayıt: 15 Haz 2008 00:14
Konum: Rakım 0
Meslek: Turizm
Yaş: 49
İleti: 1241
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aydın/Kuşadası

Cevap: MsgBox sayfanın tam ortasında olmasın.

İleti#2)  Tarkan VURAL » 05 Kas 2013 22:42

Paylaşım için teşekkür ediyorum Haldun. --)( Nerelerdesin, iyi misin ? :)
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ? O halde BAĞIŞ butonunu tıklayın...
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 18:27
Konum: @tarkanvural73
Meslek: LUU, Database Expert, Senior Software Specialist, Developer
Yaş: 45
İleti: 26990
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü

Cevap: MsgBox Sayfanın Tam Ortasında Olmasın

İleti#3)  Erhan Yavuz » 06 Kas 2013 07:07

Haldun bey sizi özledik.. Paylaşım için teşekkürler.. şkşk [evet]
☾✭ Türkçemizi tam ve doğru kullanmaktan korkmayalım..
Teşekkür etmek Erdemdir. ECYavuz


OSMANLI OYUNU (1402-1566)
http://www.excelvba.net/viewtopic.php?f=41&t=9984

EXCEL-VBA KOD BANKASI PRO.7.0
http://www.excelvba.net/viewtopic.php?f=38&t=3304
Resim
Kullanıcı avatarı
Erhan Yavuz
Site Forum Yöneticisi
 
Adı Soyadı:Erhan Yavuz
Kayıt: 15 Haz 2008 00:13
Konum: Etiler / İstanbul
Meslek: Emekli Sb.
Yaş: 60
İleti: 5695
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul / Etiler

Cevap: MsgBox Sayfanın Tam Ortasında Olmasın

İleti#4)  yerbakili » 06 Kas 2013 07:46

Teşekkürler Haldun Bey. şkşk
Kullanıcı avatarı
yerbakili
Siteye Alışmış
 
Adı Soyadı:Yasin ERBAKILI
Kayıt: 17 Tem 2009 00:26
Konum: ...
Meslek: Memur
Yaş: 31
İleti: 287
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: MsgBox Sayfanın Tam Ortasında Olmasın

İleti#5)  OrkmesB » 06 Kas 2013 10:53


Haldun ağabey, yararlı bir örnek olmuş.
Unutturma kendini abi, selamlar.
“Benim yaradılışımda fevkâlade olan bir şey varsa, Türk olarak dünyaya gelmemdir"
Kullanıcı avatarı
OrkmesB
Yönetim Kurulu
 


 
Adı Soyadı:Bahadır Örkmes
Kayıt: 14 Haz 2008 18:26
Konum: Gökçeali
Meslek: Personel Müdürü
Yaş: 40
İleti: 5028
 

Cevap: MsgBox sayfanın tam ortasında olmasın.

İleti#6)  Murat OSMA » 06 Kas 2013 13:59

Tarkan VURAL yazdı:Paylaşım için teşekkür ediyorum Haldun. --)( Nerelerdesin, iyi misin ? :)

+1 [ilginc] --)(
Kullanıcı avatarı
Murat OSMA
Site Forum Yöneticisi
 
Adı Soyadı:Murat OSMA
Kayıt: 04 Arl 2008 22:34
Konum: İstanbul
Meslek: Excel & VBA Eğitmeni
Yaş: 34
İleti: 14336
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bağcılar - İSTANBUL

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: MsgBox Sayfanın Tam Ortasında Olmasın

İleti#7)  Murat OSMA » 29 Arl 2014 01:21

API'ler ile hazırlanmış farklı bir alternatif;
Kod: Tümünü seç
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetCurrentThreadId Lib 
"kernel32" () As Long
Private Declare Function SetWindowsHookEx Lib 
"user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId 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 hHook As Long
Private msgbox_x As Long
Private msgbox_y As Long
Private Const WH_CBT 
= 5
Private Const HCBT_ACTIVATE 
= 5
Private Const SWP_NOSIZE 
= &H1
Private Const SWP_NOZORDER 
= &H4

Sub Emre
()
    MsgBoxPos "Ekran Pozisyonu", vbOKOnly, "MsgBox Konum", 1100, 550
End Sub
 
Public Sub MsgBoxPos
(strPromt As String, vbButtons As VbMsgBoxStyle, strTitle As String, xPos As Long, yPos As Long)
    msgbox_x = xPos: msgbox_y = yPos
    hHook 
= SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)
    MsgBox strPromt, vbButtons, strTitle
End Sub
 
Private Function MsgBoxHookProc
(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If lMsg 
= HCBT_ACTIVATE Then
        SetWindowPos wParam
, 0, msgbox_x, msgbox_y, 0, 0, SWP_NOSIZE + SWP_NOZORDER
        UnhookWindowsHookEx hHook
    End If
    MsgBoxHookProc 
= False
End Function 
Kullanıcı avatarı
Murat OSMA
Site Forum Yöneticisi
 
Adı Soyadı:Murat OSMA
Kayıt: 04 Arl 2008 22:34
Konum: İstanbul
Meslek: Excel & VBA Eğitmeni
Yaş: 34
İleti: 14336
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bağcılar - İSTANBUL

Cevap: MsgBox Sayfanın Tam Ortasında Olmasın

İleti#8)  Erkan Akayay » 02 Şub 2015 21:55

Şu kodlara bakıyorum da. Sayfanın neresinde olursa olsun. Bana bulaşmasında :)
Sorularınızı düzgün bir Türkçe ile, detay vererek ve örnek dosyayla destekleyerek sorunuz.
Örnek dosyalarınızda Application.Visible veya hide gibi sayfa gizlemelerini iptal ediniz.
Kullanıcı avatarı
Erkan Akayay
Site Dostu
 
Kayıt: 20 Ağu 2008 11:59
Konum: YALOVA
Meslek: Bilgi İşlem
Yaş: 49
İleti: 4028
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İSTANBUL


Forum MsgBox

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 1 misafir

Bumerang - Yazarkafe