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
| Sub test()
' Définit l'intervalle avec l'heure actuelle + 30 secondes
Dim Dans30Secondes As Date
Dans30Secondes = TimeSerial(Hour(Time), Minute(Time), Second(Time) + 30)
' Répétition de la macro dans 30 secondes
Application.OnTime Dans30Secondes, "test"
Dim IE As InternetExplorer
Dim maPageHtml As HTMLDocument
Dim Htable As IHTMLElementCollection
Dim maTable As IHTMLTable
Dim j As Integer, i As Integer
Dim Cible As String
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
IE.navigate " http://www.boursorama.com/bourse/actions/cours_az.phtml?MARCHE=1rPCAC"
Do Until IE.readyState = READYSTATE_COMPLETE
DoEvents
Loop
Set maPageHtml = IE.document
'objet type table
Set Htable = maPageHtml.getElementsByTagName("table")
'deuxième tableau dans la page Web
Set maTable = Htable(0)
' cache l'execution du programmme sur excel
Application.ScreenUpdating = False
'boucle sur toutes les lignes du tableau
For i = 1 To maTable.Rows.Length
'boucle sur les cellules dans chaque ligne
For j = 1 To maTable.Rows(i - 1).Cells.Length
Cible = maTable.Rows(i - 1).Cells(j - 1).innerHTML
If Left(Cible, 8) = "<A href=" Then
Feuil1.Hyperlinks.Add Cells(i, j), Mid(Cible, 10, InStr(10, Cible, ">") - 11)
Else
Cells(i, j) = maTable.Rows(i - 1).Cells(j - 1).innerText
End If
Next j
Next i
' quitter la page internet
IE.Quit
'Suppression colonne inutile
Feuil1.Range("A:A,C:C,I:I,J:J").Delete
' Redimenssionne les cellules
Columns("A:A").ColumnWidth = 30
Columns("B:F").ColumnWidth = 15
Columns("B:F").HorizontalAlignment = xlCenter
' Suppression du (c)
Dim montexte As String
Dim resultat As String
Dim k As Integer
If Right(Feuil1.Cells(2, 2), 3) = "(c)" Then
For k = 2 To 41
montexte = Feuil1.Cells(k, 2)
resultat = Left(montexte, Len(montexte) - 4)
Feuil1.Cells(k, 2) = resultat
Next k
End If
' Remplacement des . par des . et Bordure tableau
With Feuil1.Range("A1:F41")
.Replace ".", "."
.Borders.LineStyle = xlContinuous
End With
' rend visible le résultat sur excel
Application.ScreenUpdating = True
' efface le contenu des variables
Set IE = Nothing
Set maPageHtml = Nothing
Set Htable = Nothing
Set maTable = Nothing
End Sub |
Partager