numero de fenêtre d'un programme lancé par shell

XL_Luc

XLDnaute Occasionnel
Bonjour,

Aujourd'hui, pour tester une applicatione externe, je la lance par shell et pour vérifier son "état" via son nom de fenêtre j'utilise getwindowtext.
Le probleme est que j'estime à priori que cette application est active car je recupère le numero de la fenêtre par getforegroundwindow :

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 GetForegroundWindow Lib "user32" () As Long

---------------------------------------------------

Maintenant, j'aimerai sécuriser l'application en étant "sur" que mon programme lancé par le shell e st bien le programme actif.
Pour ça, je pense utiliser le numéro ID renvoyé lors du lancemetnt du shell et la ... je seche.

Merci pour votre aide.
 

XL_Luc

XLDnaute Occasionnel
Re : numero de fenêtre d'un programme lancé par shell

Je met mon codemais il appelle en l'état une application propriétaire donc pas de test possible.
Néanmoins, la problématique serait la même en appelant le CALC.EXE par exemple. Comment savoir avec l'ID de lancement u calc (ici la variable ID_SAGA) quelle est le hwnd de la fenêtre.

Code:
Private Const SAGA = "G:\TR\AZ4132\Az41asag.exe /l TR /d TR /c M47 /e TR /n 0000"

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 GetForegroundWindow Lib "user32" () As Long
Public ID_SAGA As Long

Function LancementTransaction(transac As String) As Boolean
Dim temp As String
    LancementTransaction = True
    ID_SAGA = LancementSAGA
    temp = WindowTitle
    SendKeys transac & "{ENTER}", True
    AttenteReponse temp
    If EstHabilite = False Then
        LancementTransaction = False
        SendKeys "{ENTER}", True
        SendKeys "{TAB}", True
        SendKeys "{TAB}", True
        SendKeys "{ENTER}", True
        MsgBox "Accès à la transaction impossible", vbExclamation, "Accès..."
    End If
End Function

Function LancementSAGA() As Double
    LancementSAGA = Shell(SAGA, vbMaximizedFocus)
    AttenteLancement_SAGA
End Function

Sub AttenteLancement_SAGA()
Dim wnd_title As String
    Do
        wnd_title = WindowTitle
        DoEvents
    Loop While Trim(wnd_title) <> "Saisie Code Transaction - MSA"
End Sub

Sub AttenteReponse(wnd_title As String)
    Do
        DoEvents
    Loop While WindowTitle = wnd_title
End Sub

Function WindowTitle() As String
Dim hwnd As Long
Dim wnd_title As String
    hwnd = 0
    wnd_title = Space(256)
    hwnd = GetForegroundWindow
    GetWindowText hwnd, wnd_title, Len(wnd_title)
    wnd_title = Replace(wnd_title, Chr(0), "")
    WindowTitle = Trim(wnd_title)
End Function

Function EstHabilite() As Boolean
    EstHabilite = True
    If WindowTitle = "Saga" Then EstHabilite = False
End Function


Sub ExtractT54()
Dim i As Long
Dim temp As String
Dim oClass As Workbook
    i = 1
    Application.SheetsInNewWorkbook = 1
    Set oClass = Workbooks.Add
    If LancementTransaction("T54") = False Then
        GoTo fin
    End If
    temp = WindowTitle
    SendKeys "00", True
    SendKeys "09", True
    'pour test comtpe en fixe
    SendKeys "4061", True
    SendKeys "{ENTER}", True
    AttenteReponse temp
    
    Stop
    
    MsgBox ID_SAGA
    
    Stop
    Do While WindowTitle <> "Saisie Code Transaction - MSA"
        temp = WindowTitle
        SendKeys "%", True
        SendKeys "{RIGHT}", True
        SendKeys "{DOWN}", True
        SendKeys "{DOWN}", True
        SendKeys "{ENTER}", True
        oClass.Sheets(1).Paste (oClass.Sheets(1).Cells(i, 1))
        i = i + 23
        SendKeys "{ENTER}", True
        AttenteReponse temp
    Loop
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{ENTER}", True
    MiseEnForme oClass
fin:
    Application.SheetsInNewWorkbook = 3
End Sub

Sub MiseEnForme(oClass As Workbook)
Dim i As Long
Dim nPC As Variant
    oClass.Activate
    Sheets(1).Select
    i = 1
    Do While Cells(i, 1) <> ""
        nPC = Trim(Mid(Cells(i, 1), 3, 8))
        If Len(nPC) <> 8 Or IsNumeric(nPC) = False Then
            Rows(i).Delete
            i = i - 1
        End If
        i = i + 1
    Loop
    Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 9), Array(2, 2), Array(10, 9), Array(12, 2), Array(21, 9), _
        Array(23, 4), Array(29, 9), Array(31, 2), Array(61, 1), Array(78, 2)), _
        TrailingMinusNumbers:=True
    Columns.AutoFit
End Sub
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 472
Messages
2 088 709
Membres
103 928
dernier inscrit
MIKETUAU