Açık Programların Listesi ve İstenen Programın Ekrana Gelmesi

[asi_kral]

Selamun Aleyküm
Bilgisayarımzdaki açık olan tüm programların listesini ve dilediğim programın ekranda aktif olmasını istiyorum.
Örneğin Açık 5 Program var
1 - Outlok
2 - Whatsapp
3 - Crome
4- Excel
5 - Word
v.b.

Ben bunlardan birini aynı mouse tıklıyormuş gibi aktif hale getirmek istiyorum.
Yarımlarınız için şimdiden teşekkürler.

 

[asi_kral]

Selamun Aleyküm
hatırlatmak istedim.

 

[Korhan Ayhan]

Forumda arama yapmalısınız.

Size ait bir konu alttadır.

Açık Olan Tüm Programların İsimlerini Listelemek

Merhaba Windowsta açık olan tüm programların listesini nasıl alabilirim. Örneğin; Microsoft Outlook WhatsApp TeamViewer Görev Zamanlayıcı vb.

www.excel.web.tr

Benzer konular..

Soru - Çalışan programları Combo da Fitrelemek

Merhaba arkadaşlar; alttaki kod ile çalışan programları combo ya ekliyorum. yapmak istediğim F harfi ile başlayanları yüklemek... bunu nasıl yapabilirim ? Private Sub cmdLoad_Click() Dim oServ As Object Dim cProc As Variant Dim oProc As Object Combo1.Clear Set oServ =...

www.excel.web.tr

Çalışan programları listelemek

Görev yöneticisinde Uygulamalar bölümünde görünen (çalışan) programları/dosyaları nasıl listeleyebiliriz. Bu sitede araştırma yaptım. aşağıdaki koddan yararlanmaya çalıştım ama yapamadım. yardımlarınızı bekliyorum. (listelemek olmayabilir. Uygulama çalışıyor, Yada kapalı mesaj vermesi yeterli)...

www.excel.web.tr

 

[asi_kral]

Hocam teşekkür ederim. Arama yaptım hatta konuya Haluk Bey'in verdiği cevap var yalnız ona göre programı ekran'a getirmeyi başaramadım.

 

[excelokyanus500]

Sanırım bu şekilde istiyorsunuz.

Dosya

 

[excelokyanus500]

Bulunsun..

Private Declare PtrSafe Function apiGetClassName Lib "user32" Alias _
                "GetClassNameA" (ByVal hwnd As Long, _
                ByVal lpClassName As String, _
                ByVal nmaxCount As Long) As Long
Private Declare PtrSafe Function apiGetDesktopWindow Lib "user32" Alias _
                "GetDesktopWindow" () As Long
Private Declare PtrSafe Function apiGetWindow Lib "user32" Alias _
                "GetWindow" (ByVal hwnd As Long, _
                ByVal wCmd As Long) As Long
Private Declare PtrSafe Function apiGetWindowLong Lib "user32" Alias _
                "GetWindowLongA" (ByVal hwnd As Long, ByVal _
                nIndex As Long) As Long
Private Declare PtrSafe Function apiGetWindowText Lib "user32" Alias _
                "GetWindowTextA" (ByVal hwnd As Long, ByVal _
                lpString As String, ByVal aint As Long) As Long
Private Const mcGWCHILD = 5
Private Const mcGWHWNDNEXT = 2
Private Const mcGWLSTYLE = (-16)
Private Const mcWSVISIBLE = &H10000000
Private Const mconMAXLEN = 255
Option Compare Text

Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLW Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nmaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function ShowWindow32 Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdSHow As Long) As Long
Private Declare Function SetForegroundWindow32 Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long
#If VBA7 Then
    ' 64-bit sistemler için uyumluluk
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdSHow As Long) As Long
#Else
    ' 32-bit sistemler için uyumluluk
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdSHow As Long) As Long
#End If
Private Const GWL_ID = (-12)
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
  


  
   'FindWindowLike
   ' - Finds the window handles of the windows matching the specified
   '   parameters
   '
   'hwndArray()
   ' - An integer array used to return the window handles
   '
   'hWndStart
   ' - The handle of the window to search under.
   ' - The routine searches through all of this window's children and their
   '   children recursively.
   ' - If hWndStart = 0 then the routine searches through all windows.
   '
   'WindowText
   ' - The pattern used with the Like operator to compare window's text.
   '
   'ClassName
   ' - The pattern used with the Like operator to compare window's class
   '   name.
   '
   'ID
   ' - A child ID number used to identify a window.
   ' - Can be a decimal number or a hex string.
   ' - Prefix hex strings with "&H" or an error will occur.
   ' - To ignore the ID pass the Visual Basic Null function.
   '
   'Returns
   ' - The number of windows that matched the parameters.
   ' - Also returns the window handles in hWndArray()
   '
   '----------------------------------------------------------------------
Private Function FindWindowLike(hWndArray() As Long, ByVal hWndStart As Long, _
    WindowText As String, Classname As String, ID) As Long
Dim hwnd As Long
Dim r As Long
' Hold the level of recursion:
Static level As Long
' Hold the number of matching windows:
Static iFound As Long
Dim sWindowText As String
Dim sClassname As String
Dim sID
    
    ' Initialize if necessary:
    If level = 0 Then
        iFound = 0
        ReDim hWndArray(0 To 0)
        If hWndStart = 0 Then hWndStart = GetDesktopWindow()
    End If
    ' Increase recursion counter:
    level = level + 1
    ' Get first child window:
    hwnd = GetWindow(hWndStart, GW_CHILD)
    Do While hwnd <> 0
        DoEvents ' Not necessary
    
        ' Search children by recursion:
        r = FindWindowLike(hWndArray(), hwnd, WindowText, Classname, ID)
        ' Get the window text and class name:
        sWindowText = Space(255)
        r = GetWindowText(hwnd, sWindowText, 255)
        sWindowText = Left(sWindowText, r)
        sClassname = Space(255)
        r = GetClassName(hwnd, sClassname, 255)
        sClassname = Left(sClassname, r)
        ' If window is a child get the ID:
        If GetParent(hwnd) <> 0 Then
            r = GetWindowLW(hwnd, GWL_ID)
            sID = CLng("&H" & Hex(r))
        Else
            sID = Null
        End If
        ' Check that window matches the search parameters:
        If sWindowText Like WindowText And sClassname Like Classname Then
            If IsNull(ID) Then
                ' If find a match, increment counter and
                '  add handle to array:
                iFound = iFound + 1
                ReDim Preserve hWndArray(0 To iFound)
                hWndArray(iFound) = hwnd
            ElseIf Not IsNull(sID) Then
                If CLng(sID) = CLng(ID) Then
                    ' If find a match increment counter and
                    '  add handle to array:
                    iFound = iFound + 1
                    ReDim Preserve hWndArray(0 To iFound)
                    hWndArray(iFound) = hwnd
                End If
            End If
'            Debug.Print "Window Found: "
'            Debug.Print "  Window Text  : " & sWindowText
'            Debug.Print "  Window Class : " & sClassname
'            Debug.Print "  Window Handle: " & CStr(hwnd)
        End If
        ' Get next child window:
        hwnd = GetWindow(hwnd, GW_HWNDNEXT)
    Loop
    ' Decrement recursion counter:
    level = level - 1
    ' Return the number of windows found:
    FindWindowLike = iFound
End Function

Sub ListName()
    Dim xRg As Range
    Dim xStr As String
    Dim xStrLen As Long
    Dim xHandle As Long
    Dim xHandleStr As String
    Dim xHandleLen As Long, xHandleStyle As Long
    On Error Resume Next
    Columns("A:A").ClearContents
    Set xRg = Range("A1")
    If xRg Is Nothing Then Exit Sub
    xRg(1).Activate
    xHandle = apiGetWindow(apiGetDesktopWindow(), mcGWCHILD)
    Do While xHandle <> 0
        xStr = String$(mconMAXLEN - 1, 0)
        xStrLen = apiGetWindowText(xHandle, xStr, mconMAXLEN)
        If xStrLen > 0 Then
            xStr = Left$(xStr, xStrLen)
            xHandleStyle = apiGetWindowLong(xHandle, mcGWLSTYLE)
            If xHandleStyle And mcWSVISIBLE Then
                activecell.Value = xStr
                activecell.Offset(1, 0).Activate
            End If
        End If
        xHandle = apiGetWindow(xHandle, mcGWHWNDNEXT)
    Loop
    Call Renkata
End Sub
Public Sub myExcelActivate()
On Error Resume Next
Dim i As Integer

    i = 1
    myAppActivate activecell
    Do
        If InStr(1, Windows(i).Caption, activecell, vbTextCompare) > 0 Then Exit Do
        i = i + 1
    Loop Until i > Windows.Count
    If i <= Windows.Count Then Windows(i).Activate
End Sub

  
Public Sub myAppActivate(appTitle As String, Optional Wait As Boolean)
Dim hWndArray() As Long
Dim iret As Long
Const SW_MAXIMIZE = 3
Const SW_MINIMIZE = 6

    If Left(appTitle, 1) <> "*" Then appTitle = "*" & appTitle
    If Right(appTitle, 1) <> "*" Then appTitle = appTitle & "*"

    If FindWindowLike(hWndArray, 0, appTitle, "*", Null) > 0 Then
        iret = SetForegroundWindow32(hWndArray(1))
        iret = ShowWindow32(hWndArray(1), SW_MAXIMIZE)
    End If
End Sub


Sub MaximizeChromeWindowByTitle()
    ' Chrome penceresini başlığına göre bul
    Dim hwnd As LongPtr
    hwnd = FindWindow(vbNullString, activecell.Value)
    
    If hwnd <> 0 Then
        ' Pencereyi maksimize et
        ShowWindow hwnd, 3 ' SW_MAXIMIZE = 3
    Else
        MsgBox "Chrome penceresi bulunamadı.", vbExclamation
    End If
End Sub


 Sub SHOW()
Call myExcelActivate
CreateObject("WScript.Shell").AppActivate activecell.Text

End Sub

Sub Renkata()
Dim i As Integer
Sheets("Sheet1").Select
Columns("A:A").ClearFormats
Range("A1").Select
Last = Cells(Rows.Count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "A").Value) Like "*Word*" Then: Cells(i, "A").Interior.Color = RGB(0, 191, 255)
If (Cells(i, "A").Value) Like "*Excel*" Then: Cells(i, "A").Interior.Color = RGB(0, 255, 0)
If (Cells(i, "A").Value) Like "*Outlook*" Then: Cells(i, "A").Interior.Color = RGB(0, 255, 255)
Next i
End Sub

 

[Haluk]

Hocam teşekkür ederim. Arama yaptım hatta konuya Haluk Bey'in verdiği cevap var yalnız ona göre programı ekran'a getirmeyi başaramadım.

Korhan Bey'in 3 No'lu mesajda önerdiği en son linkte yer alan kodlar, o anda çalışmakta olan programların "Name" ve "ProcessID" özelliklerini listeler.

Hangi programa ait ekranın öne gelmesini istiyorsanız, o programa ait "ProcessID" değerini "AppActivate" komutuyla bu işi yaparsınız.

Örneğin, diyelim ki listeleme sonucunda; o sırada bir Word dosyası açık olduğundan, "WINWORD.EXE" için "ProcessID" değeri 23020 ise, aşağıdaki kodla Word dosyasını ekranda öne getirebilirsiniz.

    AppActivate (23020)

Söz konusu "ProcessID" değerleri, o anda çalışan programların TC Kimlik No'ları gibidir. Windows bunları kullanarak iş ve işlemleri yürütür. Söz konusu programa ait pencere kapanmadıkça o "ProcessID" geçerlidir. Söz konusu program veya o programla açılmış olan dosya kapatılıp tekrar açılınca bu değer değişir.


.

 

[asi_kral]

Sanırım bu şekilde istiyorsunuz.

Dosya

İlginiz için teşekkür ederim.
Yalnız dosyanız ve kodunuz henüz açılırken hata vermekte.

 

[asi_kral]

Korhan Bey'in 3 No'lu mesajda önerdiği en son linkte yer alan kodlar, o anda çalışmakta olan programların "Name" ve "ProcessID" özelliklerini listeler.

Hangi programa ait ekranın öne gelmesini istiyorsanız, o programa ait "ProcessID" değerini "AppActivate" komutuyla bu işi yaparsınız.

Örneğin, diyelim ki listeleme sonucunda; o sırada bir Word dosyası açık olduğundan, "WINWORD.EXE" için "ProcessID" değeri 23020 ise, aşağıdaki kodla Word dosyasını ekranda öne getirebilirsiniz.

    AppActivate (23020)

Söz konusu "ProcessID" değerleri, o anda çalışan programların TC Kimlik No'ları gibidir. Windows bunları kullanarak iş ve işlemleri yürütür. Söz konusu programa ait pencere kapanmadıkça o "ProcessID" geçerlidir. Söz konusu program veya o programla açılmış olan dosya kapatılıp tekrar açılınca bu değer değişir.


.

Merhaba Haluk Hocam
İlginiz için teşekkür ederim. Yalnız kodu denediğimde ekran'a getirmiyor herhangi bir işlem gerçekleşmiyor.
Linkte verilen kodun en alt satırına ( AppActivate (11168) ) bu şekilde ilave yaptım ( Ekrana getirilecek olan Outlook ) ama herhangi bir işlem olmuyor.
Teşekkür ederim.

 

[excelokyanus500]

Minimize olması halinde Pid ile winword aktif olmasına rağmen ekrana gelmeyecektir. Ancak benim yaptığım programda bu sorun aşıldı. İstediğiniz programı seçip aç demeniz yeterli. Ancak word için şunu da deneyebilirsiniz.

Sub WordAc()
Dim wdApp As Object
Dim wdAppRunning As Boolean

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number = 0 Then wdAppRunning = True
wdApp.WindowState = 1 'minimize = 2, maximize = 1, normal = 0
'MsgBox wdAppRunning
Set wdApp = Nothing

End Sub

 

[beab05]

Merhaba;

Böyle bir uygulamayı neden Excel de yapmak istiyorsunuz?

Alt + Tab ile daha pratik olmaz mı? Tabii amacınızı da bilmediğim için emin değilim