XL 2010 Ephéméride en direct dans le classeur ?

[guy72]

Bonjour
Existe-t-il une fonction ou est-il possible d'avoir les heures de lever et de coucher du soleil en direct dans Excel ?
La Tranche sur Mer (ou proche)
Merci de votre aide
Cordialement

 

[James007]

Bonjour,

As-tu un site de référence ...?

Est-ce-que le site suivant pour La Rochelle pourrait convenir :

Ephemeride.com : Calendrier solaire d'une ville

www.ephemeride.com

 

[guy72]

Bonjour,
Oui, La Rochelle me vas, à vol d'oiseau, c'est le plus près, à part ou l'île de Ré encore plus près.

 

[patricktoulon]

sbonjour tout les deux
je vais voir pour la tranche sur mer car dans ces page le code est dynamique et donc les requete xmlhttp renvoie le script des balises script et non le innerhtml résultant
en attendant j'en ai trouver une dans ce site pour paris

Sub test()
    MsgBox SunriseAndSunset
End Sub

Public Function SunriseAndSunset()
    Dim url$, code$, tables As Object, Res$
    url = "https://www.ephemeride.com/ephemeride/ephemeride/11/fetes-prenoms-soleil-citation-lune-proverbe-dictons-du-jour.html"
    Set req = CreateObject("microsoft.xmlhttp")
    With req
        .Open "get", url, False
        .send
        code = .responsetext

        With CreateObject("htmlfile")
            .body.innerhtml = code
          
           Set tables = .getelementsbytagname("TABLE")
           For i = 0 To tables.Length - 1
           'MsgBox tables(i).innertext
           If tables(i).innertext Like "*Le soleil se lève à*" Then Res = "horaire valable pour Paris " & vbCrLf & "le soleil se lève à " & Split(Split(tables(i).innertext, "Le soleil se lève à")(1), vbCrLf)(0): Exit For
        Next
        SunriseAndSunset = Res
        End With
    End With
End Function

 

[guy72]

D'accord pour ça, mais je me suis mal exprimé.
Je souhaitais avoir dans deux cellules le lever et le coucher automatiquement (comme l'heure ou le jour)

 

[patricktoulon]

re
et ben alors??????
je te donne un exemple , il ne reste plus qu'a couper le texte et mettre ce que tu veux dans les cellule que tu veux

automatique?????
ben a l'open c'est suffisant non??; le lever et coucher ne va pas changer dans la journée que je sache

 

[patricktoulon]

re
tiens j'ai trouvé sur un autre site pour la rochelle
met ca dans ton module thisworkbook
change les cellule pour celles que tu veux
ici: A1=lever et B1=coucher

Private Sub Workbook_Open()
SunriseAndSunset
End Sub
Sub SunriseAndSunset()
    Dim url$, code$,  TRS
     url = "http://calendriersolaire.com/fr/la-rochelle"
    With CreateObject("microsoft.xmlhttp"): .Open "POST", url, False: .send: code = .responsetext: End With
    With CreateObject("htmlfile")
        .body.innerhtml = code
        Set TRS = .getelementsbytagname("TABLE")(0).getelementsbytagname("TR")
        If Not TRS Is Nothing Then
            With TRS(Day(Date) + 1)
                Sheets(1).[A1] = CDate(.ChildNodes(2).innertext)
                Sheets(1).[B1] = CDate(.ChildNodes(3).innertext)
            End With
        End If
          End With
End Sub

plus simple ca va etre dificile
j'ai parler trop vite YA PLUS SIMPLE
une simple recher gogolito

donc tu remplace la sub par celle ci

pour l'ile de re

Sub SunriseAndSunset()
    Dim url$, code$, Res$, TRS
    url = "https://www.google.fr/search?ei=8bwRXsD1Ns64lwT_2YCwCg&q=lever=et+coucher+du+soleil+ a l+ile+de+re" '&oq=lever+et+coucher+du+soleil+%C3%A0+l%27+ile+de+re&gs_l=psy-ab.12...46459.61217..63650...0.2..0.382.2146.0j15j0j1......0....1..gws-wiz.......0i71j0i13i30j0i8i13i30j0i8i30.Q6nrMIWq4Kw&ved=0ahUKEwiAssjKouzmAhVO3IUKHf8sAKYQ4dUDCAo#spf=1578221462256"
        With CreateObject("microsoft.xmlhttp"): .Open "get", url, False: .send: code = .responsetext: End With
    With CreateObject("htmlfile")
        .body.innerhtml = code
        Sheets(1).[A1] = Split(Split(.body.innertext, "Résultats de recherche")(1), vbCrLf)(0)
        Sheets(1).[B1] = Split(Split(.body.innertext, "(Île de Ré)" & vbCrLf)(1), vbCrLf)(0)
        'Debug.Print .body.innertext
    End With
End Sub

sinon j'en remet une couche avec( la tranche sur mer)

Sub SunriseAndSunset()
    Dim url$, code$, Res$, TRS
    url = "https://www.google.fr/search?source=hp&ei=7MURXvzmDq-_lwSH6oS4Cg&q=lever+et+coucher+du+soleil+La+Tranche+sur+Mer"
    With CreateObject("microsoft.xmlhttp"): .Open "get", url, False: .send: code = .responsetext: End With
    With CreateObject("htmlfile")
        .body.innerhtml = code
        Sheets(1).[A1] = Split(Split(.body.innertext, "Résultats de recherche")(1), vbCrLf)(0)
        Sheets(1).[B1] = Split(Split(.body.innertext, "(La Tranche-sur-Mer)" & vbCrLf)(1), vbCrLf)(0)
        Debug.Print .body.innertext
    End With
End Sub

 

[James007]

@patricktoulon

gogolito ...!!!

Super Bien Vu ... !!!

 

[patricktoulon]

re
bonjour @James007
a noter que c'est moi qui fait le gogolito
j'aurais tres bien pu splitter le .responstext sans passer par le document virtuel html

LOL ET RE LOL

 

[guy72]

Excusez-moi, j'était parti me baigner
Je regarde ça et je vous tiens au courant

 

[guy72]

Je viens de faire des essais, exécuté plusieurs fois, ça ne fonctionne pas.
J'ai peut-être pas tout compris
J'ai remplacé (1) par (2) (le nom de ma feuille)
A1 par A27 et B1 par C27
Ça tourne, ça tourne, mais rien ne se passe, je n'ai rien dans mes cellules.

 

[patricktoulon]

re
bizarre que la requête n'aboutisse pas
en même temps 2010 je suis q'ua moitié étonné

 

[James007]

Bizarre ...

Car je peux confirmer que, de mon côté, tout fonctionne ...!!!

 

[Eric C]

Bonsoir le forum
Bonsoir Guy, James & Patrick

Pour ma part, XL 2010 - 32bits, cela fonctionne parfaitement.
PS : @guy - Depuis 4 ans, je viens passer mes vacances à Jard/mer (85) - Super la Vendée. Oui, Patrick, Toulon et sa région, c'est super aussi mais trop loin maintenant. Bonne fin de Ouikand.
@+ Eric c

 

[guy72]

J'ai mis une nouvelle feuille appelée Feuil1 (1) et j'ai lancé la macro sans la modifier
Désolé, mais rien ne se passe