Sub Vacanc()
Dim maDate As Date
Dim ws As Worksheet
Dim an1 As Integer, an2 As Integer
Dim url As String, dd As Variant, i As Integer, k As Integer
Dim col As Integer, dat1 As Date, dat2 As Date, T As Variant
Dim currentYear As Integer, selectedYear As Integer, selectedMonth As Integer
Set ws = ThisWorkbook.Sheets("Vacances")
url = "https://www.vacances-scolaires-education.fr/vacances-scolaires-2024-2025.html"
dd = Split(GetDataVac(url), vbCrLf)
For i = 5 To UBound(dd)
Select Case True
Case dd(i) Like "zoneABC*"
col = 4
dd(i) = Split(dd(i), "zoneABC ")(1)
Case dd(i) Like "zoneA*"
col = 1
dd(i) = Split(dd(i), "zoneA ")(1)
Case dd(i) Like "zoneB*"
col = 2
dd(i) = Split(dd(i), "zoneB ")(1)
Case dd(i) Like "zoneC*"
col = 3
dd(i) = Split(dd(i), "zoneC ")(1)
Case Else: col = 0
End Select
If col > 0 Then
T = Split(dd(i), " || ")
' Vérification que T(0) existe
If UBound(T) >= 0 Then
T(0) = CleanDateFormat(CStr(T(0))) ' Nettoie et corrige la date
End If
' Si T contient un seul élément, assurez-vous que T(1) existe
If UBound(T) < 1 Then
ReDim Preserve T(1) ' Redimensionner pour éviter l'erreur
T(1) = "" ' Si pas de deuxième date, mettre une valeur vide
Else
' Nettoyer la deuxième date si elle existe
T(1) = CleanDateFormat(CStr(T(1)))
End If
' Conversion sécurisée des dates
dat1 = SafeConvertDate(CStr(T(0))) ' Conversion propre (passage de T(0) comme chaîne)
dat2 = SafeConvertDate(CStr(T(1))) ' Conversion propre (passage de T(1) comme chaîne)
' Affichage des valeurs pour vérifier
Debug.Print "Date 1 : "; T(0); " -> "; dat1
Debug.Print "Date 2 : "; T(1); " -> "; dat2
If dat1 > 0 And dat2 > 0 Then
For k = 0 To dat2 - dat1
If col = 4 Then
ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 3).Value = dat1 + k
Else
ws.Cells(ws.Rows.Count, col).End(xlUp).Offset(1).Value = dat1 + k
End If
Next k
Else
Debug.Print "Erreur de conversion de date pour : "; dd(i)
End If
End If
Next i
End Sub
' Fonction de nettoyage pour supprimer les jours de la semaine et autres éléments non pertinents
Function CleanDateFormat(dateString As String) As String
Dim cleanedDate As String
' Supprimer les jours de la semaine (par exemple "Samedi", "Dimanche", etc.)
cleanedDate = Replace(dateString, "Lundi", "")
cleanedDate = Replace(cleanedDate, "Mardi", "")
cleanedDate = Replace(cleanedDate, "Mercredi", "")
cleanedDate = Replace(cleanedDate, "Jeudi", "")
cleanedDate = Replace(cleanedDate, "Vendredi", "")
cleanedDate = Replace(cleanedDate, "Samedi", "")
cleanedDate = Replace(cleanedDate, "Dimanche", "")
' Nettoyer les espaces inutiles
cleanedDate = Trim(cleanedDate)
' Retourner la date nettoyée
CleanDateFormat = cleanedDate
End Function
' Fonction de conversion sécurisée d'une date (convertit une chaîne en date si possible)
Function SafeConvertDate(dateString As String) As Date
On Error Resume Next ' Ignore les erreurs si la conversion échoue
SafeConvertDate = DateValue(dateString) ' Tente la conversion
On Error GoTo 0 ' Désactive l'ignorance des erreurs après la tentative
End Function
' Fonction pour récupérer les données des vacances
Function GetDataVac(url As String) As String
Dim req As Object, tables As Object, table As Object, trs As Object, tds As Object
Dim zoneA As String, zoneB As String, zoneC As String, titrevacance As String, Data As String
Dim i As Integer, T As Variant, code As String
Dim tj As Variant
Set req = CreateObject("microsoft.xmlhttp")
req.Open "GET", url, False
req.send
code = req.responseText
If req.ReadyState = 4 Then
If req.Status <> 200 Then
MsgBox "Erreur lors du chargement de la page.", vbExclamation, "Erreur"
Exit Function
End If
End If
tj = Split("lundi,mardi,mercredi,jeudi,vendredi,samedi,dimanche", ",")
For i = 0 To UBound(tj)
code = Replace(code, "Du " & tj(i), "")
code = Replace(code, " au " & tj(i), "||")
Next
code = Replace(code, "1er", "1")
code = Replace(code, "Lundi ", "")
With CreateObject("htmlfile")
.body.innerHTML = code
Set tables = .body.getElementsByTagName("table")
If tables.Length = 0 Then
MsgBox "Aucune table trouvée sur la page.", vbExclamation, "Erreur"
Exit Function
End If
Set table = tables(0)
Set trs = table.getElementsByTagName("tr")
For i = 2 To trs.Length - 2
Set tds = trs(i).getElementsByTagName("td")
zoneA = "": zoneB = "": zoneC = ""
titrevacance = trs(i).Children(0).innerText
zoneA = Split(trs(i).Children(1).innerText, vbCrLf)(0)
T = Split(zoneA, "||"): zoneA = "zoneABC " & Trim(T(0))
If UBound(T) > 0 Then zoneA = zoneA & " || " & Trim(T(1))
If tds.Length >= 2 Then
zoneA = trs(i).Children(1).innerText
T = Split(zoneA, "||"): zoneA = "zoneA " & Trim(T(0)) & " || " & Trim(T(1))
zoneB = trs(i).Children(2).innerText
T = Split(zoneB, "||"): zoneB = "zoneB " & Trim(T(0)) & " || " & Trim(T(1))
zoneC = trs(i).Children(3).innerText
T = Split(zoneC, "||"): zoneC = "zoneC " & Trim(T(0)) & " || " & Trim(T(1))
End If
Data = Data & vbCrLf & titrevacance & vbCrLf & zoneA & vbCrLf & zoneB & vbCrLf & zoneC & vbCrLf & "--------------------------------------- "
Next
End With
GetDataVac = Data
End Function
