Private Const WM_CLOSE As Long = &H10 Private Const HTCAPTION As Long = 2& Private Const GW_HWNDNEXT As Long = 2& Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) 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 Dim hPidAppPFX as long private sub FxRun() hPidAppPFX = Shell("C:\NET\FX5\RUN\FXWIN.EXE") end sub private sub FxStop() Call SendMessage(InstanceToWnd(hPidAppPFX), WM_CLOSE, HTCAPTION, ByVal 0&) end sub 'http://www.codyx.org/snippet_recuperer-hwnd-handle-partir-pid-process-id_451.aspx#1462 private Function InstanceToWnd(ByVal target_pid As Long) As Long 'API-Guid Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long test_hwnd = FindWindow(ByVal 0&, ByVal 0&) Do While test_hwnd <> 0& If GetParent(test_hwnd) = 0& Then test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid) If test_pid = target_pid Then InstanceToWnd = test_hwnd Exit Do End If End If test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT) Loop End Function
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionPrivate Const WM_CLOSE As Long = &H10 Private Const HTCAPTION As Long = 2& Private Const GW_HWNDNEXT As Long = 2& Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) 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 Sub CommandButton2_Click() Dim chemin As Variant Dim nomdefichier As String Dim newnomdefichier As String Dim newnomdefichier2 As String Dim MyAppPFX As Long If TextBox1.Value = "" Then MsgBox "please choose FX input file location", vbCritical Else Sheets("feuil1").Range("A1").Value = UserForm1.TextBox1.Value nomdefichier = Sheets("feuil1").Range("A1").Value newnomdefichier = "c:\net\fx5\work\files\new.dat" FileCopy nomdefichier, newnomdefichier Workbooks.OpenText FileName:=newnomdefichier, _ Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _ Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _ Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)) ' Application.Run Range("AUTOSAUV.XLA!mcs02.OnTime") Range("A1:O30").Select Selection.Copy Windows("fxtest2.xls").Activate Range("A1").Select ActiveSheet.Paste Range("A1").Select Windows("new.dat").Activate Range("F5").Select Application.CutCopyMode = False ActiveWorkbook.Close Kill newnomdefichier UserForm1.Hide 'Create the new pfx input file Sheets("Case1").Select Sheets("Case1").Copy ActiveWorkbook.SaveAs FileName:="C:\net\fx5\work\files\run.dat", _ FileFormat:=xlText, CreateBackup:=False ActiveWorkbook.Close MyAppPFX = Shell("C:\NET\FX5\RUN\FXWIN.EXE") ChDir "C:\net\fx5\work" Workbooks.OpenText FileName:="C:\net\fx5\work\FX.OUT", Origin:= _ xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _ Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _ Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _ , 1)) Cells.Select Selection.Copy Windows("fxtest2.xls").Activate Sheets("feuil5").Select Range("A1").Select ActiveSheet.Paste Range("A1").Select Windows("FX.OUT").Activate Range("A1").Select Application.CutCopyMode = False ActiveWorkbook.Close newnomdefichier2 = "C:\net\fx5\work\files\run.dat" Kill newnomdefichier2 End If Call SendMessage(InstanceToWnd(MyAppPFX), WM_CLOSE, HTCAPTION, ByVal 0&) End Sub 'http://www.codyx.org/snippet_recuperer-hwnd-handle-partir-pid-process-id_451.aspx#1462 Private Function InstanceToWnd(ByVal target_pid As Long) As Long 'API-Guid Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long test_hwnd = FindWindow(ByVal 0&, ByVal 0&) Do While test_hwnd <> 0& If GetParent(test_hwnd) = 0& Then test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid) If test_pid = target_pid Then InstanceToWnd = test_hwnd Exit Do End If End If test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT) Loop End Function