Pb:Nommer une cellule variable dans une macro

Bonjour le forum,

Ok...je la joint...mais il n'y a rien de différent de la dernière que j'ai jointe si ce n'est cette boucle tant que...

https://www.excel-pratique.com/~files/doc/XLmEcSuivi_valeurs_v1.0.xls

Je ne connais pas cette forme de requête avec un fichier .iqy, tu aurais un exemple en tête de mise en forme? qu'est que cela pourrait donner sur la macro du fichier Excel de notre exemple?

Merci a tous

E.C

re,

Tu peux toujours essayer ceci :

Sub classsification_Yahoo()
' classsification_Yahoo Macro
Dim J As Integer, i As Integer
Application.ScreenUpdating = False
J = 5
i = 3
    With Sheets("Feuille2")
    .Select
    While Sheets("Feuille1").Cells(J, 3) <> ""
        With .QueryTables.Add(Connection:= _
        "URL;http://fr.finance.yahoo.com/q/pr?s=" & _
        Sheets("Feuille1").Cells(J, 3), Destination:=Range("$B$3"))
        .Name = "ls?s=" & Sheets("Feuille1").Cells(J, 3)
        .FieldNames = True
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SaveData = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "23"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .Refresh BackgroundQuery:=False
        End With
    .Range("C4").Copy Destination:=Sheets("Feuille3").Range("C" & i)
    i = i + 1
    .Range("B3:C8").ClearContents
    J = J + 1
    Wend
    End With
End Sub

MAintenant c'est lourd à gérer car comme Myta te le dit avant, il est plus simple de reprendre une page entière puis de la traiter ensuite.

Fais un essai avec excel via Données / Exécuter une requete et là choisis les options proposées en standard.

Amicalement

Dan

Salut le forum

Sans avoir regarder le fichier joint, voilà une requête avec un fichier .iqy

A tester : Requete_Yahoo_Condition

Enregistre le fichier sur ton disque avant de pouvoir l'exécuter

Mytå

Re le forum

La macro modifiée, avec gestion d'erreur si le code n'existe pas.

Option Explicit

Sub Req_Yahoo()
Dim J As Byte
Dim Ligne As Byte
Dim Source As Worksheet
Dim Requete As Worksheet
Dim Repertoire As String
Dim RangeObj As Object

Repertoire = ThisWorkbook.Path

Set Source = Sheets("Feuille1")
Set Requete = Sheets("Feuille2")

Application.ScreenUpdating = False

Range("K5:M" & Range("B65536").End(3).Row).ClearContents

For J = 5 To Range("C65536").End(3).Row

If Source.Cells(J, 3) <> "" Then

'Creer Fichier Pour La Requete
If Dir(Repertoire & "\hr_6.iqy") = "hr_6.iqy" Then Kill (Repertoire & "\hr_6.iqy")

Open Repertoire & "\hr_6.iqy" For Append As #1

Print #1, "WEB"
Print #1, "1"
Print #1, "http://fr.finance.yahoo.com/q/pr?s=" & Sheets("Feuille1").Cells(J, 3)
Print #1, ""
Print #1, "Selection = EntirePage"
Print #1, "Formatting = None"
Print #1, "PreFormattedTextToColumns = True"
Print #1, "ConsecutiveDelimitersAsOne = True"
Print #1, "SingleBlockTextImport = False"
Print #1, "DisableDateRecognition = False"
Close #1

With Requete
    .Activate
    With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;C:\Yahoo\hr_6.iqy", Destination _
        :=Requete.Range("A1"))
        .Name = Source.Cells(J, 3)
        .FieldNames = False
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = False
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .Refresh BackgroundQuery:=False
    End With
'Copy data de la requête

    Set RangeObj = Cells.Find(What:="ISIN:", After:=ActiveCell, _
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False)

    If Not RangeObj Is Nothing Then
      Ligne = RangeObj.Row
        .Range("B" & Ligne).Copy Source.Range("K" & J)
        .Range("B" & Ligne + 1).Copy Source.Range("L" & J)
        .Range("B" & Ligne + 2).Copy Source.Range("M" & J)
        Source.Range("K" & J & ":M" & J).VerticalAlignment = xlCenter
            With .Cells
              .Delete
            End With
    Else
      Source.Range("K" & J) = "Erreur, Référence Non Trouvée..."
          With .Cells
            .Delete
          End With
    End If

End With

End If

Next J

Source.Activate
Application.ScreenUpdating = True

End Sub

Mytå

Bonsoir le forum,

Désolé j'ai pas été trop présent aujourd'hui... mais je vais regarder toutes vos suggestions d'améliorations qui a priori sont très bonnes et qui font bien progresser la macro...

Merci encore Mytå, Dan et les autres,

E.C

Re le forum

Avec ma méthode la page entière est télécharger, et avec .Find tu peux récupérer

les valeurs désirées, je te laisse découvrir.

A te relire, si d'autres problèmes

Mytå

P.S. Dan, tu peux me dire si cette macro fonctionne sous Mac, tu es la seule personne,

que je connais qui est sous cette plateforme.

bonjour a tous,

juste une petite question: comment créer un fichier en .iqy?

Merci

E.C

Re le forum

Pour créer un fichier.iqy

'Creer Fichier Pour La Requete 
If Dir(Repertoire & "\hr_6.iqy") = "hr_6.iqy" Then Kill (Repertoire & "\hr_6.iqy") 

Open Repertoire & "\hr_6.iqy" For Append As #1 

Print #1, "WEB" 
Print #1, "1" 
Print #1, "http://fr.finance.yahoo.com/q/pr?s=" & Sheets("Feuille1").Cells(J, 3) 
Print #1, "" 
Print #1, "Selection = EntirePage" 
Print #1, "Formatting = None" 
Print #1, "PreFormattedTextToColumns = True" 
Print #1, "ConsecutiveDelimitersAsOne = True" 
Print #1, "SingleBlockTextImport = False" 
Print #1, "DisableDateRecognition = False" 
Close #1

Tu remplaces la ligne

Print #1, "http://fr.finance.yahoo.com/q/pr?s=" & Sheets("Feuille1").Cells(J, 3) 

Par l'url de la page à lire.

Tu peux aussi utiliser le bloc-notes pour le créer manuellement.

WEB
1
http://fr.finance.yahoo.com/q/pr?s=FR0000125486

Selection = EntirePage
Formatting = None
PreFormattedTextToColumns = True
ConsecutiveDelimitersAsOne = True
SingleBlockTextImport = False
DisableDateRecognition = False

Mytå

Salut Mytå,

oui Ok... mais quand tu dis tu remplaces

Print #1, "http://fr.finance.yahoo.com/q/pr?s=" & Sheets("Feuille1").Cells(J, 3)

par l'url de la page à lire.

Ben et si il y a plusieurs pages?

Merci de ta réponse

E.C

Re le forum

Tu fais un boucle, sur ta liste d'url, comme dans le fichier fourni.

Sinon tu fais un fichier par url si tu veux les conserver. (hr_1, hr_2, etc...)

Sinon j'ai rien compris, ou tu expliques mal ta vrai demande.

Mytå

Bonsoir,

Myta pour répondre à ta demande de contrôle sous MAC, voici le code à modifier.

Il faut enlever :

• les \ et les remplacer par :
• éliminer quelques instructions. Elles sont précédées d'une apostrophe

J'ai défini une variable REPERTOIREIQY qui reprend le répertoire où sera créé le fichier IQY. Dans cette variable, il faut modifier TATA par le nom de l'utilisateur de l'ordinateur.

"DESKTOP" étant le bureau bien entendu et pouvant être également changé.

Sub Req_YahooMac()
Dim J As Byte
Dim Ligne As Byte
Dim Source As Worksheet
Dim Requete As Worksheet
Dim Repertoire As String
Dim RangeObj As Object

Repertoire = ThisWorkbook.Path
Repertoireiqy = "Macintosh HD:Users:TATA:Desktop:"
Set Source = Sheets("Feuille1")
Set Requete = Sheets("Feuille2")

Application.ScreenUpdating = False

Range("K5:M" & Range("B65536").End(3).Row).ClearContents

For J = 5 To Range("C65536").End(3).Row

If Source.Cells(J, 3) <> "" Then

'Creer Fichier Pour La Requete
If Dir(Repertoire & ":hr_6.iqy") = "hr_6.iqy" Then Kill (Repertoire & ":hr_6.iqy")

Open Repertoire & ":hr_6.iqy" For Append As #1

Print #1, "WEB"
Print #1, "1"
Print #1, "http://fr.finance.yahoo.com/q/pr?s=" & Sheets("Feuille1").Cells(J, 3)
Print #1, ""
Print #1, "Selection = EntirePage"
Print #1, "Formatting = None"
Print #1, "PreFormattedTextToColumns = True"
Print #1, "ConsecutiveDelimitersAsOne = True"
Print #1, "SingleBlockTextImport = False"
Print #1, "DisableDateRecognition = False"
Close #1

With Requete
.Activate
With ActiveSheet.QueryTables.Add(Connection:="FINDER;" & Repertoireiqy & "hr_6.iqy", Destination:=Requete.Range("A1"))
.Name = Source.Cells(J, 3)
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
'.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
'.RefreshPeriod = 0
'.WebSelectionType = xlEntirePage
'.WebFormatting = xlWebFormattingNone
'.WebPreFormattedTextToColumns = True
'.WebConsecutiveDelimitersAsOne = True
'.WebSingleBlockTextImport = False
'.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With
'Copy data de la requête

Set RangeObj = Cells.Find(What:="ISIN:", After:=ActiveCell, _
 LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not RangeObj Is Nothing Then
 Ligne = RangeObj.Row
.Range("B" & Ligne).Copy Source.Range("K" & J)
.Range("B" & Ligne + 1).Copy Source.Range("L" & J)
.Range("B" & Ligne + 2).Copy Source.Range("M" & J)
Source.Range("K" & J & ":M" & J).VerticalAlignment = xlCenter
With .Cells
.Delete
 End With
 Else

Source.Range("K" & J) = "Erreur, Référence Non Trouvée..."
With .Cells
.Delete
 End With
End If
End With
End If
Next J
Source.Activate
Application.ScreenUpdating = True
End Sub

Amicalement

Dan

Re le forum

Dan, merci pour le test, on va le mettre dans cours et astuces avec les deux macros,

sur un exemple de fichier.

Je te laisse faire ou je m'en occupe

A te relire

Mytå

Re Myta,

C'est toi qui a réalisé le code; Il me parait donc plus correct de te laisser le soin de le faire.

Amicalement

Dan

Re le forum

Dan tu n'as pas le code pour remplacer

Repertoireiqy = "Macintosh HD:Users:TATA:Desktop:"

par le répertoire ou le fichier en enregistré, dans le style

repertoireiqy=ThisWorkbook.Path

A te relire

Mytå

P.S. Pour détecter la plateforme MAC ou PC, j'ai la solution en vue

salut Mytå,

en fait ce que je veux dire c'est qu'il y a plusieurs valeurs a traiter et donc faudrait il plusieurs pages a sauvegarder? ... cela ferait beaucoup a traiter et a mettre en mémoire, Non?

Merci

E.C

Re le forum

Tu fais une première requete, tu gardes les données souhaitées,

et tu boucles pour récuprer les autres données.

Tu veux juste garder les données qui t'interesses.

Tu nous quoi lire, pour les pages on va boucler, et on doit garder quoi ?

On peut tout mettre dans une seule page avec les macros.

La limite c'est la manière de poser ton problème, pour le reste le VBA va le faire.

Mytå

P.S. Meme de faire que ton fichier soit compatible sous MAC et PC

Merci a Tous pour vos réponses... ça m'a beaucoup aidé

E.C

Re,

Message pour Myta,

J'avais effectivement essayé de remplacer poar THISWORKBOOK. PATH mais assez curieursement alors que cette instruction fonctionne sous MAC, j'ai toujours un bug.

Peut-être est-ce du coté de la déclaration de variable.

Je vois cela ce soir et te tiens au courant.

Amicalement

Dan

re,

Message pour Myta :

J'ai retesté le code.

Si 'lon remplace cette instruction

With ActiveSheet.QueryTables.Add(Connection:="FINDER;" & Repertoireiqy & "hr_6.iqy", Destination:=Requete.Range("A1"))

par

With ActiveSheet.QueryTables.Add(Connection:="FINDER;" & Repertoire & ":" & "hr_6.iqy", Destination:=Requete.Range("A1"))

On peut supprimer la variable "Repertoireiqy".et l'inxtruction "Repertoireiqy = "Macintosh HD:Users:Djn:Desktop:" "

Amicalement

Dan