est il possible de rafraichir automatiquement une image=20
sur une feuille excel grace =E0 lien internet? En fait j'ai=20
une feuille excel ayant des d=E9tails m=E9t=E9orologiques et je=20
veut qu'au chaque ouverture excel t=E9l=E9charge=20
automatiquement l'image du temps du lendemain sur un site=20
internet.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Papyty
Bonjour @ tous et à Matthieu :
automatiquement l'image du temps du lendemain sur un site internet.
Je te propose une réponse faite il ya quelque temps sur le groupe:
*Copie* Si tu veux juste récuperer l'image je te propose de la charger par son nom, car je pense que les images sont changées mais gardent le meme nom pour ne pas refaire les liens à chaque fois. Mais à vérifier dans le temps!!! Si c'est le cas je te propose cette macro que j'ai testé avec une image valide et une pas valide du moins au moment des tests.
Sub Test() On Error Resume Next ActiveSheet.Pictures.Insert("http://www.eumetsat.de/mdrs/img/jpg/D2_F_late st.jpg").Select If Error <> "" Then MsgBox "L'image D2_F_latest.jpg n'existe pas" On Error Resume Next ActiveSheet.Pictures.Insert("http://www2.bluewin.ch/information/wetter/mn/ wetter_symbole.gif").Select If Error <> "" Then MsgBox "L'image wetter_symbole.gif n'existe pas" End Sub *Fin de copie*
Pour que ce soit automatique à l'ouverture du fichier aller dans ThisWorkbook et coller la macro dans Private Sub Workbook_Open()
End Sub
Est ce que ça convient?? -- @+ Thierry 07/12/2003 00:02:55
Bonjour @ tous et à Matthieu :
automatiquement l'image du temps du lendemain sur un site
internet.
Je te propose une réponse faite il ya quelque temps sur le groupe:
*Copie*
Si tu veux juste récuperer l'image je te propose de la charger par son nom,
car je pense que les images sont changées mais gardent le meme nom pour ne
pas refaire les liens à chaque fois. Mais à vérifier dans le temps!!!
Si c'est le cas je te propose cette macro que j'ai testé avec une image
valide et une pas valide du moins au moment des tests.
Sub Test()
On Error Resume Next
ActiveSheet.Pictures.Insert("http://www.eumetsat.de/mdrs/img/jpg/D2_F_late
st.jpg").Select
If Error <> "" Then MsgBox "L'image D2_F_latest.jpg n'existe pas"
On Error Resume Next
ActiveSheet.Pictures.Insert("http://www2.bluewin.ch/information/wetter/mn/
wetter_symbole.gif").Select
If Error <> "" Then MsgBox "L'image wetter_symbole.gif n'existe pas"
End Sub
*Fin de copie*
Pour que ce soit automatique à l'ouverture du fichier aller dans
ThisWorkbook et coller la macro dans
Private Sub Workbook_Open()
End Sub
Est ce que ça convient??
--
@+
Thierry
07/12/2003 00:02:55
automatiquement l'image du temps du lendemain sur un site internet.
Je te propose une réponse faite il ya quelque temps sur le groupe:
*Copie* Si tu veux juste récuperer l'image je te propose de la charger par son nom, car je pense que les images sont changées mais gardent le meme nom pour ne pas refaire les liens à chaque fois. Mais à vérifier dans le temps!!! Si c'est le cas je te propose cette macro que j'ai testé avec une image valide et une pas valide du moins au moment des tests.
Sub Test() On Error Resume Next ActiveSheet.Pictures.Insert("http://www.eumetsat.de/mdrs/img/jpg/D2_F_late st.jpg").Select If Error <> "" Then MsgBox "L'image D2_F_latest.jpg n'existe pas" On Error Resume Next ActiveSheet.Pictures.Insert("http://www2.bluewin.ch/information/wetter/mn/ wetter_symbole.gif").Select If Error <> "" Then MsgBox "L'image wetter_symbole.gif n'existe pas" End Sub *Fin de copie*
Pour que ce soit automatique à l'ouverture du fichier aller dans ThisWorkbook et coller la macro dans Private Sub Workbook_Open()
End Sub
Est ce que ça convient?? -- @+ Thierry 07/12/2003 00:02:55
gee-dee-
Bonsoir papyty, toujours a partir de la réponse faite il y a quelque temps ( qui comporte un message d'erreur :'((( une adaptation à un autre site qui fonctionne : '======================= ce qui suit est a coller dans un module standard---- Public i_image As String '............................................ Sub updateMeteo() Set Meteo = ActiveWorkbook Workbooks.Open ("http://www.fou-d-l.be/fr/club/imsat.shtml") Set InternetBook = ActiveWorkbook Call test_image ActiveSheet.Shapes(i_image).Select ' ----------copie l'image SAT Selection.CopyPicture Meteo.Activate Meteo.Worksheets.Add ActiveSheet.Paste InternetBook.Close End Sub '................................................................ Sub test_image() Dim larg, haut, shap For Each shap In ActiveSheet.Shapes i_image = shap.Name larg = ActiveSheet.Shapes(i_image).Height haut = ActiveSheet.Shapes(i_image).Width If larg * haut > 100000 Then Exit Sub Next End Sub '================ fin de copie ================ @+
Bonsoir papyty,
toujours a partir de la réponse faite il y a quelque temps ( qui comporte un
message d'erreur :'(((
une adaptation à un autre site qui fonctionne :
'======================= ce qui suit est a coller dans un module
standard----
Public i_image As String
'............................................
Sub updateMeteo()
Set Meteo = ActiveWorkbook
Workbooks.Open ("http://www.fou-d-l.be/fr/club/imsat.shtml")
Set InternetBook = ActiveWorkbook
Call test_image
ActiveSheet.Shapes(i_image).Select
' ----------copie l'image SAT
Selection.CopyPicture
Meteo.Activate
Meteo.Worksheets.Add
ActiveSheet.Paste
InternetBook.Close
End Sub
'................................................................
Sub test_image()
Dim larg, haut, shap
For Each shap In ActiveSheet.Shapes
i_image = shap.Name
larg = ActiveSheet.Shapes(i_image).Height
haut = ActiveSheet.Shapes(i_image).Width
If larg * haut > 100000 Then Exit Sub
Next
End Sub
'================ fin de copie ================
@+
Bonsoir papyty, toujours a partir de la réponse faite il y a quelque temps ( qui comporte un message d'erreur :'((( une adaptation à un autre site qui fonctionne : '======================= ce qui suit est a coller dans un module standard---- Public i_image As String '............................................ Sub updateMeteo() Set Meteo = ActiveWorkbook Workbooks.Open ("http://www.fou-d-l.be/fr/club/imsat.shtml") Set InternetBook = ActiveWorkbook Call test_image ActiveSheet.Shapes(i_image).Select ' ----------copie l'image SAT Selection.CopyPicture Meteo.Activate Meteo.Worksheets.Add ActiveSheet.Paste InternetBook.Close End Sub '................................................................ Sub test_image() Dim larg, haut, shap For Each shap In ActiveSheet.Shapes i_image = shap.Name larg = ActiveSheet.Shapes(i_image).Height haut = ActiveSheet.Shapes(i_image).Width If larg * haut > 100000 Then Exit Sub Next End Sub '================ fin de copie ================ @+
Papyty
Bonjour @ tous et à gee-dee- :
toujours a partir de la réponse faite il y a quelque temps ( qui comporte un
message d'erreur :'((( une adaptation à un autre site qui fonctionne :
Donc ceci devrait fonctionner
Sub Test() On Error Resume Next ActiveSheet.Pictures.Insert _ ("http://www.meteo.be/gfx/Images/Satellite/Meteosat/MSDUSIR.jpg") _ .Select If Error <> "" Then MsgBox "MSDUSIR.jpg n'est pas en ligne" End Sub
A verifier ;-))) -- @+ Thierry 07/12/2003 01:24:50
Bonjour @ tous et à gee-dee- :
toujours a partir de la réponse faite il y a quelque temps ( qui comporte
un
message d'erreur :'(((
une adaptation à un autre site qui fonctionne :
Donc ceci devrait fonctionner
Sub Test()
On Error Resume Next
ActiveSheet.Pictures.Insert _
("http://www.meteo.be/gfx/Images/Satellite/Meteosat/MSDUSIR.jpg") _
.Select
If Error <> "" Then MsgBox "MSDUSIR.jpg n'est pas en ligne"
End Sub
A verifier ;-)))
--
@+
Thierry
07/12/2003 01:24:50
toujours a partir de la réponse faite il y a quelque temps ( qui comporte un
message d'erreur :'((( une adaptation à un autre site qui fonctionne :
Donc ceci devrait fonctionner
Sub Test() On Error Resume Next ActiveSheet.Pictures.Insert _ ("http://www.meteo.be/gfx/Images/Satellite/Meteosat/MSDUSIR.jpg") _ .Select If Error <> "" Then MsgBox "MSDUSIR.jpg n'est pas en ligne" End Sub
A verifier ;-))) -- @+ Thierry 07/12/2003 01:24:50
gee-dee-
;-))) merci, impeccable Papy Thierry !!!, simplissime.... maintenant je n'ai plus besoin de la télé.... je récupère même les previsions à 3 jours
@+
;-)))
merci,
impeccable Papy Thierry !!!, simplissime....
maintenant je n'ai plus besoin de la télé....
je récupère même les previsions à 3 jours
