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 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124
| Function recup_donnéees(reunion)
Dim arrivée As String, cel As Range
Set cel = Sheets("Réunion" & reunion + 1).Range("o" & Rows.Count).End(xlUp).Offset(2, -14)
cel.Value = madate
For col = 2 To 15
simple = "": couplé = "": code = "": arrive = "": Z_234 = "": co = ""
If tablo_lien(reunion, col) <> "" Then
cel.Offset(col - 1, 3) = tabP(col - 1, 0)
With CreateObject("htmlfile")
.write recupe_html(tablo_lien(reunion, col))
'*************************************************************************************************************************
' récupération de l'arrivéee et transformation en code html (table)
Set debut = .getElementsByTagName("p")
For e = 1 To debut.Length - 1
arrive = ""
If debut(e).className = "paragraph" Then
p = p + 1
tabarr = Split(debut(e).Children(1).innertext, "-")
For Z = 0 To 4 'ubound(tabarr)
arrive = Trim(arrive) & " " & tabarr(Z)
Next
arrive = "<TD class= arrivée>" & Replace(arrive, " ", "</TD><TD class= arrivée>") & "</TD>"
Exit For
End If
Next
'Debug.Print arrive
'récupération de la dicipline
Set element = .getElementsByTagName("p")
For Each elems In element
If elems.className = "justify" Then dicp = Split(elems.innertext, " ")(0)
Next
'Debug.Print dicp
Ldate = "<TD>" & madate & "</TD>"
'récuprecaration du type de course
Set mestagA = .getElementsByTagName("a")
For Each elem In mestagA
If elem.className = "pill" Then Tc = elem.innertext
Next
Debug.Print Tc
'************************************************************************************************************************
'SG SP1 SP2 SP3 CG CP1 CP2 CP3 Zec Trio ZE4
'récupération des tables (simple zecouillon,etc....)
Set mesdivs = .getElementsByTagName("div")
For Each elem In mesdivs
If elem.className = "bigpad center" Then 'on recupére les div "bigpad center" les tableaux html sont dedans
Select Case elem.Children(0).innertext
Case "Simple"
Set matable = elem.getElementsByTagName("TABLE")(0)
Set SP = matable.getElementsByTagName("b")
For nbSP = 0 To SP.Length - 1
simple = simple & "<TD>" & Val(SP(nbSP).innertext) & "</TD>"
Next
'Debug.Print simple
Case "Jumelé"
Set matable = elem.getElementsByTagName("TABLE")(0)
Set CP = matable.getElementsByTagName("b")
For nbC = 0 To CP.Length - 1
couplé = couplé & "<TD>" & Val(CP(nbC).innertext) & "</TD>"
Next
'Debug.Print couplé
Case "ZE couillon"
ZC = "<TD>" & Val(elem.getElementsByTagName("b")(0).innertext) & "</TD>"
'Debug.Print ZC
Case "Trio"
trio = "<TD>" & Val(elem.getElementsByTagName("b")(0).innertext) & "</TD>"
'Debug.Print trio
Case "ZE 4"
ze4 = "<TD>" & Val(elem.getElementsByTagName("b")(0).innertext) & "</TD>"
'Debug.Print ze4
Case "Jumelé ordre"
co = "<TD>" & Val(elem.getElementsByTagName("b")(0).innertext) & "</TD>"
'Debug.Print ze4
Case "ZE 234"
Set matable = elem.getElementsByTagName("TABLE")(0)
Set z234 = matable.getElementsByTagName("b")
For nbC = 0 To z234.Length - 1
Z_234 = Z_234 & "<TD>" & Val(z234(nbC).innertext) & "</TD>"
Next
' Debug.Print Z_234
End Select
End If
Next
'***************************************************************************************************************************
.body.innerHTML = "<TABLE><TR>" & arrive & simple & couplé & co & ZC & trio & ze4 & Z_234 & "</TR></TABLE>"
For Each elemtd In .all
If elemtd.tagName = "TD" Then
With elemtd
.Style.Border = 1 & "px solid #000000 "
.Style.textAlign = "center"
If elemtd.className = "arrivée" Then
.Style.fontWeight = "bold"
.Style.fontFamily = "arial"
End If
End With
End If
Next
If .parentWindow.clipboardData.setData("Text", .body.innerHTML) Then
Application.ScreenUpdating = False
With Sheets("Réunion" & reunion + 1)
.Activate
cel.Offset(col - 1, 1) = dicp
cel.Offset(col - 1, 2) = Tc
cel.Offset(col - 1, 14).Select
.Paste
End With
.parentWindow.clipboardData.clearData "Text"
End If
'Debug.Print .body.innerHTML
'.body.innerHTML = ""
End With
End If
'Debug.Print "***********************************************"
Next
End Function |
Partager