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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Const URL = "https://www.euronext.com/fr/popup/data/download?ml=nyx_pd_stocks&cmd=default&formKey=nyx_pd_filter_values%3A1006ef55d4998cc0fad71db6a6f38530"
Dim OK%
Dim hWnDbandeau As Long
Dim eXtention
Dim wbkname As String
Sub euronext_csv()
DemoEuroNext_all_format 1, ".csv", 1
End Sub
Sub euronext_xls()
DemoEuroNext_all_format 1, ".xls"
End Sub
Function DemoEuroNext_all_format(mode, eXt, Optional separ)
' on choisi l'extention xls
Const EG = "edit-go"
eXtention = eXt
wbkname = Environ("USERPROFILE") & "\Downloads\Euronext_Equities_EU_" & Format(Date, "yyyy-mm-dd") & eXtention
With CreateObject("InternetExplorer.Application")
.Navigate URL
.Visible = True
While .busy Or .ReadyState < 4: DoEvents: Wend
OK = IsObject(.Document.all(EG))
If OK Then
Select Case eXt
Case ".xls": .Document.all("edit-format-1").Checked = True
Case ".csv"
.Document.all("edit-format-2").Checked = True
Select Case separ
'le document.all ne fonctionnant pas avec le id comme reference j'utilise le getelementbyid(difference entre moi et marc )
' probleme recurent entre les versions de IE
Case 1: .Document.getelementbyid("edit-decimal-separator-1").Checked = True
Case 2: .Document.getelementbyid("edit-decimal-separator-2").Checked = True
End Select
End Select
.Document.all(EG).Click
' affiche la fenetre avnt d'appuyer sur les bouton du bandeau de telechargement (facultaif ) fonctionne meme sans
While .busy: DoEvents: Wend
wait_telechargement mode
.Quit
Else
.Quit: Beep
End If
End With
End Function
Sub clickOK(mode)
ShowWindow hWnDbandeau, 2
'on simule les touche tab et enter successivement
keybd_event vbKeyTab, 0, 0, 0&
Sleep (50)
keybd_event vbKeyTab, 0, 0, 0& 'une 2 eme fois pour telecharger
Sleep (100)
keybd_event vbKeyReturn, 0&, KEYEVENTF_KEYUP, 0&: Sleep (50)
wait_fichier
If mode = 1 Then ouverture
End Sub
Sub wait_telechargement(mode)
hWnDbandeau = 0
Do
Sleep (20) ' on ralenti la boucle do pour ne pas rater le handle de la fentre de telechargement :le doevents n'etant pas suffisament efficace sur ce point
'exemple Afficher les téléchargements - Windows Internet Explorer handle =2097628
hWnDbandeau = FindWindow(vbNullString, "Afficher les téléchargements - Windows Internet Explorer")
DoEvents:
Loop Until hWnDbandeau <> 0
Sleep (300) ' une pause avnt de simuler les touche
clickOK mode
End Sub
Sub wait_fichier()
Do: Sleep (20): Loop While Dir(wbkname) = ""
End Sub
Sub ouverture()
Workbooks.Open (wbkname), Local:=True
Application.DisplayAlerts = True
traitement_fichier
End Sub
Sub traitement_fichier()
With ActiveWorkbook
Application.DisplayAlerts = False
With Sheets(1)
.Rows("1:1").Select
With ActiveWindow: .FreezePanes = False: .SplitColumn = 0: .SplitRow = 1: .FreezePanes = True: End With
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
.[G1:N1].HorizontalAlignment = xlCenter
.Cells(2).CurrentRegion.Columns(4).Replace "é", "é", xlPart
Rows("2:4").Delete Shift:=xlUp
End With
'.SaveAs Filename:=wbkname, FileFormat:=xlCSV, CreateBackup:=False
End With
Application.DisplayAlerts = True
End Sub |
re
)
Répondre avec citation
Envoyé par Marc-L
: ça peut servir aux autres 
Partager