XL 2021 Coller des données d'une page web OUVERTE vers feuille Excel

[Usine à gaz]

Bonjour à toutes et à tous,
Je vous souhaite un beau WE "calme et tranquille"

Je n'arrive pas à résoudre mon besoin et, comme d'habitude, j'en appelle à nos Ténors

Voici mon souci :
J'ai besoin à certains moments de copier les infos d'une page web "OUVERTE" après clic lien OUVERTURE SUR GOOGLE CHROME

Pour l'exemple, à coller dans fichier joint feuille "Coller ici" - J'ai fait des recherches et tentatives sans y parvenir
Important : le site "meilleursreseaux.com" présente toujours la page de la même façon, quel que soit le lien utilisé
Après la présentation des conditions, il y a toujours ensuite la rubrique "Annonces et diffusion"
J'ai donc besoin de copier tout le texte après "Services assurés et coûts" et jusqu'avant "Annonces et diffusion"

J'ai tenté également avec : Données > A partir du web >
sans y parvenir mais ce serait trop long car j'ai besoin que ce soit rapide

Je joins un petit fichier test et je continue mes recherches,
Merci à toutes et à tous

 

[Usine à gaz]

Re-Gérard

J'ai testé
lol : c'est radical car ça ferme carrément le navigateur.

Mais ça ne m'arrange pas car sur le navigateur, j'ai d'autres sites ouverts dont j'ai besoin.
En fait, il y en a 3 autres.
Ce qu'il faudrait, c'est que uniquement l'onglet :
Par exemple, j'ai cliqué sur le lien "https://meilleursreseaux.com/immobilier/mandataires/reseau-20-iad-france.html#services_couts" soit fermé (d'ailleurs il est ouvert 2 fois)

Mais je crois que ce n'est pas possible : Ne t'embêtes pas !
Je ferai sans.
C'est déjà super et rapide comme ça.
Merci Gérard

 

[job75]

Avec Ctrl+F4 au lieu de Alt+F4 c'est peut-être mieux :

CreateObject("WScript.Shell").SendKeys "^{F4}" 'fermeture de la fenêtre web

 

[Usine à gaz]

Re-Gérard
Perspicacité quand tu nous tiens lol
Merci...
Je teste

 

[Usine à gaz]

Re-Gérard
alors là, c'est bon
Mais comme il en ouvre 2
- 1 quand clic sur le lien,
- 1 quand je lance la macro (je pense)
Il en reste 1 lol

 

[job75]

Pourquoi cliquer sur un lien avant de faire le double-clic en colonne A ?

 

[Usine à gaz]

Je croyais qu'il fallait d'abord ouvrir le lien avant le double-clic ?
Mais alors comment choisir le lien à ouvrir ?
Je teste encore

 

[Usine à gaz]

Punaise, je n'avais pas vu
Effectivement, pas besoin.
Génial, c'est nickel.
Encore merci Gérard

 

[Usine à gaz]

Re-teste = impeccable

 

[Usine à gaz]

Bjr Gérard , le Forum
Evidemment Gérard ton code fonctionne parfaitement dans le contexte de ma demande et je t'en remercie

Plusieurs tentatives d'intégration dans mon fichier de travail sans succès colonnes A à AA déjà occupées.
J'ai besoin que le code soit exécutable à partir d'un module standard au clic sur cellule "B5" de la feuille.
Et c'est bien plus compliqué que ma première demande car dans mon fichier de travail l'utilisation est bien différente.
J'aurais peut-être du exposer comme dans l'utilisation dans mon fichier pour ne pas y revenir ?
Quoi que, vu le chantier, mon cher Gérard ne s'y serait peut-être pas penché pour me concocter une solution.

Voici le cadre du fonctionnement souhaité dans le cadre du fichier de travail
1 - J'ai besoin que le code se lance à la sélection du réseau (cellule "B5) de Feuil1

Private Sub Worksheet_SelectionChange(ByVal R As Range)
'CHOIX AVEC AVEC TARGET
If Not Intersect(R, Range("B5")) Is Nothing Then
Réseau_select.Show
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("b5")) Is Nothing Then
    If Target <> "Conditions Réseau" Then
        LoadExplorer
        [a1].Select
        'Target = "Conditions Réseau"
    End If
End If
End Sub

'ET CODE GERARD DANS UN MODULE STANDARD

2 - à l'ouverture du site, le code dans un module standard est appelé en fin du code "Private Sub Worksheet_Change(ByVal Target As Range)"

Je sais, certainement encore plus compliqué à faire mais...
En cas de possibilité, j'ai tout préparé dans le fichier test joint.
Encore MERCI

 

[job75]

Bonjour Lionel,

Désolé, je ne peux pas t'aider en l'état, c'est trop compliqué pour moi.

A+

 

[Usine à gaz]

Bjr Gérard
Merci d'avoir regardé.
Effectivement, c'est certainement "coton" à faire.

 

[job75]

Bon finalement ce n'est pas trop compliqué; j'ai adapté le code du module liens :

Const Attente1 = 3 / 86400 '3 secondes
Const Attente2 = 1 / 86400 '1 seconde

Sub LoadExplorer()
Dim x$
If ActiveCell = "iad" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-20-iad-france.html#services_couts"
If ActiveCell = "safti" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-35-safti.html#services_couts"
If ActiveCell = "drhouse" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-62-dr-house-immo.html#services_couts"
If ActiveCell = "capifrance" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-9-capi-france.html#services_couts"
If ActiveCell = "megagence" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-30-megagence.html#services_couts"
If ActiveCell = "immoliaison" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-24-immoliaison.html#services_couts"
If ActiveCell = "thedoorman" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-133-the-door-man.html#services_couts"
If ActiveCell = "agentmandataire" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-50-agentmandatairefr.html#services_couts"
If ActiveCell = "bsk" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-8-bsk-immobilier.html#services_couts"
If ActiveCell = "optimhome" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-31-optimhome.html#services_couts"
[A1].Select
If x = "" Then Exit Sub
With Sheets("Coller ici")
    .Cells.Delete 'RAZ
    Application.Goto .[A1]
End With
ThisWorkbook.FollowHyperlink x
Application.OnTime Now + Attente1, "Copier"
End Sub

Sub Copier()
CreateObject("WScript.Shell").SendKeys "^a^c" 'touches Ctrl+A et Ctrl+C
Application.OnTime Now + Attente2, "Coller"
End Sub

Sub Coller()
On Error Resume Next
With Sheets("Coller ici")
    .Paste 'coller
    .DrawingObjects.Delete 'supprime les objets
    .Rows(.Cells.Find("Annonces et diffusion", , xlValues).Row & ":" & .Rows.Count).Delete
    .Rows("1:" & .Cells.Find("Services assurés et coûts").Row - 1).Delete
    .Columns(1).ColumnWidth = 255
    .Rows.AutoFit
    Application.Goto .[A1], True 'cadrage
End With
CreateObject("WScript.Shell").SendKeys "^{F4}" 'fermeture de la fenêtre web
End Sub

Chez moi j'ai dû faire passe Attente1 à 3 secondes (mon ordi est connecté à internet par mon téléphone portable).

 

[Usine à gaz]

Re-Gérard
J'avais commencé à chercher comment faire, sans succès, Evidement lol
Et j'me disais ... Et...
Tu me l'as fait, j'ai pas les mots.
Hyper de chez Hyper MERCI à toi,
Génial !!!

MERCI - MERCI

 

[job75]

Je ne comprends pas pourquoi tu utilises une Worksheet_SelectionChange, le double-clic est plus logique :

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
If Not Intersect(R, Range("B5")) Is Nothing Then Cancel = True: Réseau_select.Show
End Sub

Plus besoin de sélectionner A1.

 

[Usine à gaz]

Re-Gérard
Pour faciliter le travail de mes Commerciales et pour qu'elles n'aient pas à se demander : double clic ? - clic droit ? - clic ....

Il n'y a que des clics à faire.
Donc double clic et clic droit bloqués.