1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
| #If Win64 Then
Private Declare PtrSafe Function FindWindowExA& Lib "user32" (ByVal hParent&, ByVal hChild&, ByVal ClassName$, ByVal WindowName$)
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal MilliSeconds&)
#Else
Private Declare Function FindWindowExA& Lib "user32" (ByVal hParent&, ByVal hChild&, ByVal ClassName$, ByVal WindowName$)
Private Declare Sub Sleep Lib "kernel32" (ByVal MilliSeconds&)
#End If
Const MSG = "DemoEuroNextCsvIEAuto :", PROC = "ThisWorkbook.IEAuto"
Dim IE As New InternetExplorer, D As Date, H&, T!
Sub DemoEuroNextCsvIEAuto()
Const EG = "edit-go"
T = Timer
IE.Navigate "https://www.euronext.com/fr/popup/data/download?ml=nyx_pd_stocks&cmd=default&formKey=nyx_pd_filter_values%3A1006ef55d4998cc0fad71db6a6f38530"
While IE.Busy Or IE.ReadyState < READYSTATE_COMPLETE: DoEvents: Wend
If Not IsObject(IE.Document.all(EG)) Then
IE.Visible = True: T = 0: Beep: Set IE = Nothing
Else
With Application
If IIf(.UseSystemSeparators, .International(xlDecimalSeparator), .DecimalSeparator) = "," Then _
IE.Document.all("edit-decimal-separator-2").Checked = True
End With
IE.Document.all("edit-format-2").Checked = True
IE.Document.all(EG).Click
Do: H = FindWindowExA(IE.HWND, 0&, "Frame Notification Bar", vbNullString): Loop Until H
' Sleep 700
IE.Visible = True
IEAuto
End If
End Sub
Private Sub IEAuto()
Dim oIUIAIP As IUIAutomationInvokePattern, oCUIA As New CUIAutomation
On Error Resume Next
Set oIUIAIP = oCUIA.ElementFromHandle(ByVal H).FindFirst(TreeScope_Subtree, _
oCUIA.CreatePropertyCondition(UIA_NamePropertyId, "Ouvrir")). _
GetCurrentPattern(UIA_InvokePatternId)
oIUIAIP.Invoke
Set oIUIAIP = Nothing: Set oCUIA = Nothing
If Err.Number Then
Debug.Print MSG; Err.Number
T = 0: Beep: Set IE = Nothing
Else
D = Now + 0.00002: Application.OnTime D, PROC
End If
End Sub
Private Sub Workbook_Deactivate()
If ActiveWorkbook.Name Like "*_Equities_EU_*.csv" And T Then
Debug.Print MSG; Format$(Timer - T, " 0.000s")
On Error Resume Next
Application.OnTime D, PROC, , False
T = 0: IE.Quit: Set IE = Nothing
On Error GoTo 0
Application.ScreenUpdating = False
With ActiveWorkbook.ActiveSheet.Cells(1).CurrentRegion
Feuil1.Name = .Cells(2, 1).Value & " " & .Cells(3, 1).Text
.Cells(4, 1).Clear: Feuil1.UsedRange.Clear
.Cells(5, 1).CurrentRegion.Copy Feuil1.Cells(2, 2)
With Feuil1.Cells(2, 2).CurrentRegion
Union(.Columns(5), .Columns(11)).HorizontalAlignment = xlCenter
Union(.Columns("F:I"), .Columns(13)).NumberFormat = "#,##0.000 "
.Columns(12).NumberFormat = "#,##0 "
.Columns("A:D").AutoFit: .Columns(10).AutoFit: .Columns(13).AutoFit
End With
.Rows(1).Copy Feuil1.Cells(2)
End With
ActiveWorkbook.Close False
With Feuil1
.[G1:N1].HorizontalAlignment = xlCenter
.Cells(2).CurrentRegion.Columns(4).Replace "é", "é", xlPart
.Activate: Cells(2, 1).Select: ActiveWindow.FreezePanes = True
End With
Application.ScreenUpdating = True
End If
End Sub
' • Temporisations : - ligne 27 : conditionne l'ouverture du premier coup (effet "flash")
' - ligne 45 : délai du prochain IEAuto en cas de loupé (1 jour = 86400s * 0.00002 = 1.7s)
' • Ligne 37 : bouton à déclencher |
Répondre avec citation
: ça peut servir aux autres 
Envoyé par Marc-L
…
Partager