sélection par catégories et par fonds

albert

XLDnaute Occasionnel
bonsoir lebarbo, le forum,
pour créer une routine de sélection des pages dans



il faut travailler sur les adresses.

ça n'a pas l'air simple :

Actions amérique du nord - catégories
http://www.morningstar.fr/catqt/ret...%3B%7CSortBy%3DCategoryName%7CSortOrder%3DASC

fonds
http://www.morningstar.fr/catqt/ret...%3B%7CSortBy%3DCategoryName%7CSortOrder%3DASC

Actions Euroland - catégories
http://www.morningstar.fr/benchmark...s=Actions Amérique du Nord Moy./Petites Cap.;

fonds
http://www.morningstar.fr/catqt/ret...%3B%7CSortBy%3DCategoryName%7CSortOrder%3DASC

[file name=morningstarRendement.zip size=13426]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/morningstarRendement.zip[/file]
 

Pièces jointes

  • morningstarRendement.zip
    13.1 KB · Affichages: 102

lebarbo

XLDnaute Occasionnel
Bonjour Hellboy et à ceux qui passe par là...

Ouiiiiiiiiiiiiiiiiiiiiii après mainte et mainte réflexion j'ai réussi à trouver le problème :

ancien code :
Select Case .ComboBox1.Value
Case 'Sociétés', 'Promoteurs'
intNBFiltreCount = 3
Case Else
intNBFiltreCount = 2
End Select

nouveau code :
Select Case .ComboBox1.Value
Case 'Sociétés'
intNBFiltreCount = 12
Case 'Promoteurs', 'PEA'
intNBFiltreCount = 11
Case 'Skandia'
intNBFiltreCount = 10

Case Else
intNBFiltreCount = 2
End Select

En effet pour mettre au point le filtre automatique j'ai été obligé de masquer des colonnes dans promoteurs et sociétés donc soit je déplace la colonne Catégorie et applique seulement 3 filtres automatiques soit je mets le nouveau code pour 12 filtres mais 9 masqués. A savoir lequel prend le moins de temps...???

Yess...je suis content :woohoo:

Bye
 

lebarbo

XLDnaute Occasionnel
re
pas beaucoup de temps juste le temps de mettre le nouveau fichier
je dois vérifier si ça marche pour PEA.
J'ai déplacé la colonne Catégorie dans les feuilles où ça merdait et après j'ai remis l'ancien code, dans ce sens ça économise du temps (surtout valable pour la feuille PEA)

le nouveau fichier :


Bon week-end
Bye
 

lebarbo

XLDnaute Occasionnel
bonjour hellboy,

il y a peut-être un truc que tu peux faire si tu y arrives mais je ne doute pas de toi ;) . Je t'explique...quand on a la boite de dialogue userform1 et qu'on met TELECHARGEMENT directement sans faire une sélection ça plante j'aimerai mettre à la place un message du style 'Choississez une requête de téléchargement avant de télécharger' il faudrais faire pareil quand on choisit un thème par exemple 'Sociétés' et qu'on ne choisit pas de société après...ça plante aussi sinon.

Voili merci d'avance
bye bon week-end

PS : pour MSN désolé j'étais plus là.
 

Hellboy

XLDnaute Accro
Bonjour Sylvain

Voici le code 'Magique' qui va répondre a tes attentes( du moins j'espère) :)

Tu remplace le code qui est lié avec le Bontoun de téléchargement, avec celui-ci.

Private Sub CommandButton1_Click()
 
With UserForm1
      .Hide
        Application.ScreenUpdating =
True
        Application.ScreenUpdating =
False
       
Select Case .ComboBox1.Value
             
Case Empty
                    MsgBox 'Vous n'avez fait aucune sélection, cessez de faire l'idiot ! Y-en a marre a la fin !', vbExclamation, 'Sélection'
                    .Show
             
Case 'Skandia', 'PEA'
                    opcvm
             
Case Else
                   
If IsNull(.ListBox1.Value) Then
                        MsgBox 'Vous n'avez fait aucune sélection, cessez de faire le morron ! Y-en a marre a la fin !', vbExclamation, 'Sélection'
                      .Show
                   
Else
                        opcvm
                   
End If
       
End Select
 
End With
End Sub



Il se peut que tu désire changer quelque peu le message d'avertissement ! B)

a+
 

lebarbo

XLDnaute Occasionnel
Beautiful...this code is magic :)

Bon évidemment pour le message je risque de le changer j'espère que tu ne m'en voudras pas :)

Merci beaucoup...bon je crois qu'on y vois la fin là c'est que c'est moitié triste :(

je regarde si il n'y a pas de bug et je finalise le logiciel.
Bye et encore merci
 

lebarbo

XLDnaute Occasionnel
youuuuuu on a réussi à faire une page 2 du post :)
d'ailleurs pour info je n'arrive tjrs pas à retrouver notre post dans le forum...

je n'ai pas été long pour te trouver un nouveau défi :)
je viens de faire un essai sur la feuille 'Catégorie' avec la sélection : Mixte SEK et on a ce bug qui arrive :

dblNbPageCalcul = Mid(dblNbPageCalcul, 1, InStr(1, dblNbPageCalcul, Chr(32)) - 1) / 30

Le bug fait référence a une feuille qui est vide (il y a juste la moyenne)


Je voudrais savoir si on peut également faire un message avertissant l'utilisateur.

Il serait bon d'en faire un aussi avec le bug suivant :
.Refresh BackgroundQuery:=False
du style 'Impossible de se connecter. Vérifier que vous êtes connecté et/ou télécharger à nouveau votre sélection.'

Merci d'avance bye

Message édité par: lebarbo, à: 01/08/2005 09:35
 

lebarbo

XLDnaute Occasionnel
Bonjour Hellboy,

je suis en train de faire plein de tests pour ficeler le logiciel en ce moment et je viens de me rendre compte de quelque chose concernant le bug dans la feuille catégories quand tu télécharges une page vide comme l'exemple que je t'avais donné (Mixte SEK) et si tu appuies sur 'fin' toute la page est biaisée : effacement des titres des colonnes, boutons qui s'emboitent... donc après ce bug tu ne peux plus télécharger une autre catégorie dans cette feuille. Je voudrais savoir si il y avait une possibilité pour déjà mettre un message d'alerte et ensuite 'bloquer' la page sur le dernier téléchargement, c'est à dire que le dernier téléchargement valable va rester sur la page au lieu que la macro efface toute la page.

Je ne sais pas si je suis très clair :eek: si tu m'as mal compris dis le moi.

Encore merci pour ton aide précieuse.
 

Hellboy

XLDnaute Accro
re lebardo

Excuse moi, j'ai oublié de t'écrire hier, pour te dire que je n'étais pas en mesure de télécharger ton fichier. La page WEB étais inacessible.

Si j'essairai de regarder ça sur ma demi-heure de diner. Je sais que le temps presse pour toi. Ton stage fini quand déjà ?

Il faudrait faire du ménage ds le fichier. En fait, il serait bon que tu créer un nouveau fichier viège, en le batissant avec ce que contient ta version finale, finale. La raison de ça( et je ne connais pas pourquoi ça fait ça !) c'est que Excel, semble accumuler de l'info ds le fichier a titre de référence de tout les enregistrement fait par le passé. Je suis sur de l,info que je de dis , mais encore une fois, je ne peux t'expliquer le pourquoi. Si tu veux, je me porte volontaire pour faire cette tâche à la fin. Il serait bon que ta boite aie une copie vièrge fonctionnel.


Bon et bien finalement , j'ai eu le temps de regarder pour ne nombre de page a 0. J'ai fais deux petite modifif sur deux partie du code pour contrer ce problème. Je t'envoie les 2 partie.


Private Function NbPage_All(Demande As String)
Dim Plus As Byte
Dim dblNbPageCalcul As Variant
If Demande = 'de ' Then
  Plus = 3
Else
  Plus = 4
End If

dblNbPageCalcul = Mid(Cells(60000, 2), InStr(Cells(60000, 2), Demande) + Plus, 10)
dblNbPageCalcul = Trim(Mid(dblNbPageCalcul, 1, InStr(1, dblNbPageCalcul, Chr(32)) - 1) / 30)
NbPage_All = Application.WorksheetFunction.RoundUp(dblNbPageCalcul, 0)

End Function


et:


    ' Téléchargement des fonds
    If intNbPage > 0 Then
   
' Téléchargement des fonds
    For intPageCount = intStartPage To intNbPage
       
Select Case strChoix
             
Case 'Sociétés'
                   
' Téléchargement Pour le courtTerme.
                    strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&pageno=' & intPageCount
                   
Call Societe(strAdresse, 'A' & [B65536].End(xlUp).Offset(5, -1).Row, '5')
                   
If intPageCount = intNbPage Then
                     
'Va chercher les infos de la société(étiquete)
                      strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & 'pageno=0'
                      Range('BA1:BL9').ClearContents
                     
Call Societe(strAdresse, 'BA1', '3')
                      Range('BA8:BE9').Copy Destination:=Range('BA7:BE8')
                      Range('BA2:BF8').Copy Destination:=Range('BA1:BF7')
                      Columns('BA:BF').EntireColumn.Hidden =
True
                      Application.ScreenUpdating =
True
                      Range('B8').Select
                   
End If
                   
' Téléchargement Pour le longTerme.
                    strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&pageno=' & intPageCount
                   
Call Societe(strAdresse, 'V' & [Y65536].End(xlUp).Offset(5, 1).Row, '5')
                   
' Téléchargement Pour les catégories et écarts types.
                    strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&pageno=' & intPageCount
                   
Call Societe(strAdresse, 'AK' & [AM65536].End(xlUp).Offset(4, 1).Row, '5')

             
Case 'Catégories (% act. oblig. cash)'
                   
' Téléchargement Pour le courtTerme.
                    strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&PlusMinus=0&tab=OVRVW&sortby=b_FundName&sortorder=ASC&Firstletter=&pageNo=' & intPageCount & '&GraphCid=&GraphFundNames='
                   
Call Societe(strAdresse, 'A' & [C65536].End(xlUp).Offset(2, -2).Row, '9')
                   
' Téléchargement Pour le longTerme.
                    strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&PlusMinus=0&tab=PERFO&sortby=b_FundName&sortorder=ASC&Firstletter=&pageNo=' & intPageCount & '&GraphCid=&GraphFundNames='
                   
Call Societe(strAdresse, 'W' & [Y65536].End(xlUp).Offset(2, 1).Row, '9')
                   
         
             
Case 'PEA'
                   
' Téléchargement Pour le courtTerme.
                    strAdresse = 'URL;http://www.morningstar.fr/fundselec...MEC=&FundCategory_Id=-1&MSCategory_Id=-1&BaseCurrency_ISO=&Domicile_ISO=&CountrySpecific_Attributes=1&CountrySpecific_Category=-1&ManagementFee=-1&ManagerTenure=-1&IncOrAcc=-1&YTD=&1Month=&3Month=&1Year=&3Year=&Rating=-1&Std3Year=&Sharpe=&EqSize=0&EqValue=0&FiSize=-1&FiValue=-1&Sector_ID=-1&Region_ID=-1&PctSector_ID=-1&PctRegion_ID=-1&Sector_Pct=-1&Region_Pct=-1&pageno=' & intPageCount
                   
Call Societe(strAdresse, 'A' & [B65536].End(xlUp).Offset(2, -1).Row, '7')
                   
' Téléchargement Pour le longTerme.
                    strAdresse = 'URL;http://www.morningstar.fr/fundselec...MEC=&FundCategory_Id=-1&MSCategory_Id=-1&BaseCurrency_ISO=&Domicile_ISO=&CountrySpecific_Attributes=1&CountrySpecific_Category=-1&ManagementFee=-1&ManagerTenure=-1&IncOrAcc=-1&YTD=&1Month=&3Month=&1Year=&3Year=&Rating=-1&Std3Year=&Sharpe=&EqSize=0&EqValue=0&FiSize=-1&FiValue=-1&Sector_ID=-1&Region_ID=-1&PctSector_ID=-1&PctRegion_ID=-1&Sector_Pct=-1&Region_Pct=-1&pageno=' & intPageCount
                   
Call Societe(strAdresse, 'W' & [Y65536].End(xlUp).Offset(2, -1).Row, '7')
                   
' Téléchargement Pour les catégories et écarts types.
                    strAdresse = 'URL;http://www.morningstar.fr/fundselec...MEC=&FundCategory_Id=-1&MSCategory_Id=-1&BaseCurrency_ISO=&Domicile_ISO=&CountrySpecific_Attributes=1&CountrySpecific_Category=-1&ManagementFee=-1&ManagerTenure=-1&IncOrAcc=-1&YTD=&1Month=&3Month=&1Year=&3Year=&Rating=-1&Std3Year=&Sharpe=&EqSize=0&EqValue=0&FiSize=-1&FiValue=-1&Sector_ID=-1&Region_ID=-1&PctSector_ID=-1&PctRegion_ID=-1&Sector_Pct=-1&Region_Pct=-1&pageno=' & intPageCount
                   
Call Societe(strAdresse, 'AL' & [AM65536].End(xlUp).Offset(1, -1).Row, '7')
             
Case 'Skandia'
                    strTableException = '7'
                   
If intPageCount = intNbPage Then
                      strTableException = '4'
                   
End If
                   
' Téléchargement Pour le courtTerme.
                    strAdresse = 'URL;CCurrency_ISO=&sDomicile_ISO=&BaseCurrency_ISO=&sManagementFee=-1&ManagerTenure=-1&IncOrAcc=-1&sYTD=&s1Month=&s3Month=&s1Year=&s3Year=&sRating=&lRating=-1&sStd3Year=&sSharpe=&lSize=0&EqSize=-1&EqValue=-1&FiSize=-1&FiValue=-1&lSector_Id=-1&lRegion_Id=-1&PctSector_ID=-1&PctRegion_ID=-1&Sector_Pct=-1&Region_Pct=-1&ISA=0&PEP=0&CAT=0&INS=0&sCouCat=&CountrySpecific_Category=-1&tab=RSLTS&Currency_ISO=&sortby=b_FundName&sortorder=ASC&Firstletter=&pageNo=' & intPageCount
                   
Call Societe(strAdresse, 'A' & [B65536].End(xlUp).Offset(2, -1).Row, strTableException)
                   
' Téléchargement Pour le longTerme.
                    strAdresse = 'URL;CCurrency_ISO=&sDomicile_ISO=&BaseCurrency_ISO=&sManagementFee=-1&ManagerTenure=-1&IncOrAcc=-1&sYTD=&s1Month=&s3Month=&s1Year=&s3Year=&sRating=&lRating=-1&sStd3Year=&sSharpe=&lSize=0&EqSize=-1&EqValue=-1&FiSize=-1&FiValue=-1&lSector_Id=-1&lRegion_Id=-1&PctSector_ID=-1&PctRegion_ID=-1&Sector_Pct=-1&Region_Pct=-1&ISA=0&PEP=0&CAT=0&INS=0&sCouCat=&CountrySpecific_Category=-1&tab=HSTRY&Currency_ISO=&sortby=b_FundName&sortorder=ASC&Firstletter=&pageNo=' & intPageCount
                   
Call Societe(strAdresse, 'W' & [Y65536].End(xlUp).Offset(2, -1).Row, strTableException)
                   
' Téléchargement Pour les catégories et écarts types.
                    strAdresse = 'URL;CCurrency_ISO=&sDomicile_ISO=&BaseCurrency_ISO=&sManagementFee=-1&ManagerTenure=-1&IncOrAcc=-1&sYTD=&s1Month=&s3Month=&s1Year=&s3Year=&sRating=&lRating=-1&sStd3Year=&sSharpe=&lSize=0&EqSize=-1&EqValue=-1&FiSize=-1&FiValue=-1&lSector_Id=-1&lRegion_Id=-1&PctSector_ID=-1&PctRegion_ID=-1&Sector_Pct=-1&Region_Pct=-1&ISA=0&PEP=0&CAT=0&INS=0&sCouCat=&CountrySpecific_Category=-1&tab=RSKRT&Currency_ISO=&sortby=b_FundName&sortorder=ASC&Firstletter=&pageNo=' & intPageCount
                   
Call Societe(strAdresse, 'AL' & [AN65536].End(xlUp).Offset(4, -1).Row, strTableException)
             
Case 'Promoteurs'
                 
' Téléchargement Pour le courtTerme.
                  strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&tab=RSLTS&sortby=b_FundName&sortorder=ASC&Firstletter=&pageNo=' & intPageCount
                 
Call Societe(strAdresse, 'A' & [B65536].End(xlUp).Offset(5, -1).Row, '7')
                   
If intPageCount = intNbPage Then
                   
'Va chercher les infos de la société(étiquete)
                  strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&tab=RSLTS&sortby=b_FundName&sortorder=ASC&Firstletter=&pageNo=1'
                  Range('BA1:BL9').ClearContents
                     
Call Societe(strAdresse, 'BA1', '4')
                      Range('BA8:BE9').Copy Destination:=Range('BA7:BE8')
                      Range('BA2:BF8').Copy Destination:=Range('BA1:BF7')
                      Columns('BA:BF').EntireColumn.Hidden =
True
                      Application.ScreenUpdating =
True
                      Range('B8').Select
                   
End If
                 
' Téléchargement Pour le longTerme.
                  strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&tab=HSTRY&Firstletter=&pageNo=' & intPageCount & '&SortBy=b_FundName&sortorder=ASC'
                 
Call Societe(strAdresse, 'V' & [Y65536].End(xlUp).Offset(5, -1).Row, '7')
                 
' Téléchargement Pour les catégories et écarts types.
                  strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&tab=RSKRT&Firstletter=&pageNo=' & intPageCount & '&SortBy=b_FundName&sortorder=ASC'
                 
Call Societe(strAdresse, 'AL' & [AN65536].End(xlUp).Offset(8, -1).Row, '7')
             
Case 'Catégories'
                 
' Téléchargement Pour le courtTerme.
                  strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&search=&domicile=&countryspecific=&pageno=' & intPageCount
                 
Call Societe(strAdresse, 'A' & [B65536].End(xlUp).Offset(2, -1).Row, '4')
                 
' Téléchargement Pour le longTerme.
                  strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&search=&domicile=&countryspecific=&pageno=' & intPageCount
                 
Call Societe(strAdresse, 'W' & [Y65536].End(xlUp).Offset(2, -1).Row, '4')
                 
' Téléchargement Pour les catégories et écarts types.
                  strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&search=&domicile=&countryspecific=&pageno=' & intPageCount
                 
Call Societe(strAdresse, 'AL' & [AM65536].End(xlUp).Offset(1, -1).Row, '4')
                 
       
End Select
        Application.StatusBar = 'Download de MorningStar pour ' & strChoix & ': ******* page Web ' & intPageCount & ' à ' & intNbPage & '*******'
   
Next intPageCount
    Application.StatusBar = 'Prêt'
   
Else
      MsgBox 'Désolé, il n'y a aucune information disponible sur ' & strAdresse
     
Exit Sub
 
End If
Next intCode

Bonne continuité paour le testage, c'est une partie longue et pénible.

a+
 

lebarbo

XLDnaute Occasionnel
re Hellboy,

déjà pour commencer grand merci à toi pour le travail que tu fais.

Pour la refonte du logiciel, refaire le logiciel dans un autre classeur...je ne peux t'imposer de faire ce travail même si tu te proposes. Je suis capable de le faire donc comme pour une fois je peux le faire je vais le faire ;) et c'est vrai je suis d'accord avec toi ça ne pourra lui faire que du bien, j'ai remarqué également qu'il devenait de plus en plus gros sans forcémenet avoir des informations supplémentaires.

Pour le code que tu m'as fait il ne marche pas très bien et je crois avoir compris pourquoi :
quand par exemple tu veux télécharger le danemark il y a très peu de fonds et comme la première page pour cétgories s'apelle page=0 du coup il considère qu'il n'y a pas de fonds alors qu'il y en a.
J'ai vu apparaitre également d'autres bugs.
Mais j'ai peut-être une 'solution' d'après les erreurs d'Excel que je vais t'expliquer ici :
Quand on télécharge une feuille qui n'existe pas sur 'Catégories (% act. oblig. cash)' on a le bug mais on n'a pas de problème pour retélécharger derriere (inscrit par exemple dans la 'liste' le code 10000 et le nom 'rien' par exemple) alors que sur la feuille 'Catégories' on a le bug et en plus la feuille s'affiche après n'importe comment.

Autre chose que je viens de voir et là par contre je vais me taper dessus :pinch: :eek: :ermm: :huh: , c'est que la liste pour 'Catégories' n'est pas exactement la même que pour 'Catégories (% act. oblig. cash)'


Donc pour résumer trois solutions :
-soit on fait rien :)
-soit on essaye de gérer pour que la feuille 'Catégories' apparaissent comme 'Catégories (% act. oblig. cash)'
après un bug
-soit on essaye de gérer pour que la feuille 'Catégories' apparaissent comme 'Catégories (% act. oblig. cash)'
après un bug et en plus en mettant un message d'erreur

D'ailleurs pour le message d'erreur de la connexion internet si il y a un moyen de trouver quelque chose ça serait cool.


Bon voilà si t'es arrivé à la fin de mon message tu as bien du courage encore une fois merci.
juste pour info je finis le stage à la fin de la semaine :eek: lol

Moi je m'occupe de la nouvelle liste et de la refonte du logiciel

Bye a+
 

Hellboy

XLDnaute Accro
re

Je 'n'ai pas de winrar au boulot et je n'ai pas le droit de l'intaller, allors je ne suis pas en mesure de t'envoyer les modifs ds un fichier désolé.

Je t'envoie encore les endoits ou j'ai modifier le fichier. Je suis au boulot alors pas le temsp de vérifier a fond.


    intNbPage = NbPage_All(Type_Demande)
    Range('A60000:C60005').ClearContents
    Range('B8').Activate
   
If intNbPage > -1 Then
   
Select Case strChoix
         
Case 'Sociétés', 'PEA', 'Catégories'
                intStartPage = 0
                intNbPage = intNbPage - 1
         
Case Else
                intStartPage = 1
   
End Select
   
' Téléchargement des fonds
    For intPageCount = intStartPage To intNbPage
       
Select Case strChoix
             
Case 'Sociétés'
                   
' Téléchargement Pour le courtTerme.
                    strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&pageno=' & intPageCount
                   
Call Societe(strAdresse, 'A' & [B65536].End(xlUp).Offset(5, -1).Row, '5')
                   
If intPageCount = intNbPage Then
                     
'Va chercher les infos de la société(étiquete)
                      strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & 'pageno=0'
                      Range('BA1:BL9').ClearContents
                     
Call Societe(strAdresse, 'BA1', '3')
                      Range('BA8:BE9').Copy Destination:=Range('BA7:BE8')
                      Range('BA2:BF8').Copy Destination:=Range('BA1:BF7')
                      Columns('BA:BF').EntireColumn.Hidden =
True
                      Application.ScreenUpdating =
True
                      Range('B8').Select
                   
End If
                   
' Téléchargement Pour le longTerme.
                    strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&pageno=' & intPageCount
                   
Call Societe(strAdresse, 'V' & [Y65536].End(xlUp).Offset(5, 1).Row, '5')
                   
' Téléchargement Pour les catégories et écarts types.
                    strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&pageno=' & intPageCount
                   
Call Societe(strAdresse, 'AK' & [AM65536].End(xlUp).Offset(4, 1).Row, '5')

             
Case 'Catégories (% act. oblig. cash)'
                   
' Téléchargement Pour le courtTerme.
                    strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&PlusMinus=0&tab=OVRVW&sortby=b_FundName&sortorder=ASC&Firstletter=&pageNo=' & intPageCount & '&GraphCid=&GraphFundNames='
                   
Call Societe(strAdresse, 'A' & [C65536].End(xlUp).Offset(2, -2).Row, '9')
                   
' Téléchargement Pour le longTerme.
                    strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&PlusMinus=0&tab=PERFO&sortby=b_FundName&sortorder=ASC&Firstletter=&pageNo=' & intPageCount & '&GraphCid=&GraphFundNames='
                   
Call Societe(strAdresse, 'W' & [Y65536].End(xlUp).Offset(2, 1).Row, '9')
                   
         
             
Case 'PEA'
                   
' Téléchargement Pour le courtTerme.
                    strAdresse = 'URL;http://www.morningstar.fr/fundselec...MEC=&FundCategory_Id=-1&MSCategory_Id=-1&BaseCurrency_ISO=&Domicile_ISO=&CountrySpecific_Attributes=1&CountrySpecific_Category=-1&ManagementFee=-1&ManagerTenure=-1&IncOrAcc=-1&YTD=&1Month=&3Month=&1Year=&3Year=&Rating=-1&Std3Year=&Sharpe=&EqSize=0&EqValue=0&FiSize=-1&FiValue=-1&Sector_ID=-1&Region_ID=-1&PctSector_ID=-1&PctRegion_ID=-1&Sector_Pct=-1&Region_Pct=-1&pageno=' & intPageCount
                   
Call Societe(strAdresse, 'A' & [B65536].End(xlUp).Offset(2, -1).Row, '7')
                   
' Téléchargement Pour le longTerme.
                    strAdresse = 'URL;http://www.morningstar.fr/fundselec...MEC=&FundCategory_Id=-1&MSCategory_Id=-1&BaseCurrency_ISO=&Domicile_ISO=&CountrySpecific_Attributes=1&CountrySpecific_Category=-1&ManagementFee=-1&ManagerTenure=-1&IncOrAcc=-1&YTD=&1Month=&3Month=&1Year=&3Year=&Rating=-1&Std3Year=&Sharpe=&EqSize=0&EqValue=0&FiSize=-1&FiValue=-1&Sector_ID=-1&Region_ID=-1&PctSector_ID=-1&PctRegion_ID=-1&Sector_Pct=-1&Region_Pct=-1&pageno=' & intPageCount
                   
Call Societe(strAdresse, 'W' & [Y65536].End(xlUp).Offset(2, -1).Row, '7')
                   
' Téléchargement Pour les catégories et écarts types.
                    strAdresse = 'URL;http://www.morningstar.fr/fundselec...MEC=&FundCategory_Id=-1&MSCategory_Id=-1&BaseCurrency_ISO=&Domicile_ISO=&CountrySpecific_Attributes=1&CountrySpecific_Category=-1&ManagementFee=-1&ManagerTenure=-1&IncOrAcc=-1&YTD=&1Month=&3Month=&1Year=&3Year=&Rating=-1&Std3Year=&Sharpe=&EqSize=0&EqValue=0&FiSize=-1&FiValue=-1&Sector_ID=-1&Region_ID=-1&PctSector_ID=-1&PctRegion_ID=-1&Sector_Pct=-1&Region_Pct=-1&pageno=' & intPageCount
                   
Call Societe(strAdresse, 'AL' & [AM65536].End(xlUp).Offset(1, -1).Row, '7')
             
Case 'Skandia'
                    strTableException = '7'
                   
If intPageCount = intNbPage Then
                      strTableException = '4'
                   
End If
                   
' Téléchargement Pour le courtTerme.
                    strAdresse = 'URL;CCurrency_ISO=&sDomicile_ISO=&BaseCurrency_ISO=&sManagementFee=-1&ManagerTenure=-1&IncOrAcc=-1&sYTD=&s1Month=&s3Month=&s1Year=&s3Year=&sRating=&lRating=-1&sStd3Year=&sSharpe=&lSize=0&EqSize=-1&EqValue=-1&FiSize=-1&FiValue=-1&lSector_Id=-1&lRegion_Id=-1&PctSector_ID=-1&PctRegion_ID=-1&Sector_Pct=-1&Region_Pct=-1&ISA=0&PEP=0&CAT=0&INS=0&sCouCat=&CountrySpecific_Category=-1&tab=RSLTS&Currency_ISO=&sortby=b_FundName&sortorder=ASC&Firstletter=&pageNo=' & intPageCount
                   
Call Societe(strAdresse, 'A' & [B65536].End(xlUp).Offset(2, -1).Row, strTableException)
                   
' Téléchargement Pour le longTerme.
                    strAdresse = 'URL;CCurrency_ISO=&sDomicile_ISO=&BaseCurrency_ISO=&sManagementFee=-1&ManagerTenure=-1&IncOrAcc=-1&sYTD=&s1Month=&s3Month=&s1Year=&s3Year=&sRating=&lRating=-1&sStd3Year=&sSharpe=&lSize=0&EqSize=-1&EqValue=-1&FiSize=-1&FiValue=-1&lSector_Id=-1&lRegion_Id=-1&PctSector_ID=-1&PctRegion_ID=-1&Sector_Pct=-1&Region_Pct=-1&ISA=0&PEP=0&CAT=0&INS=0&sCouCat=&CountrySpecific_Category=-1&tab=HSTRY&Currency_ISO=&sortby=b_FundName&sortorder=ASC&Firstletter=&pageNo=' & intPageCount
                   
Call Societe(strAdresse, 'W' & [Y65536].End(xlUp).Offset(2, -1).Row, strTableException)
                   
' Téléchargement Pour les catégories et écarts types.
                    strAdresse = 'URL;CCurrency_ISO=&sDomicile_ISO=&BaseCurrency_ISO=&sManagementFee=-1&ManagerTenure=-1&IncOrAcc=-1&sYTD=&s1Month=&s3Month=&s1Year=&s3Year=&sRating=&lRating=-1&sStd3Year=&sSharpe=&lSize=0&EqSize=-1&EqValue=-1&FiSize=-1&FiValue=-1&lSector_Id=-1&lRegion_Id=-1&PctSector_ID=-1&PctRegion_ID=-1&Sector_Pct=-1&Region_Pct=-1&ISA=0&PEP=0&CAT=0&INS=0&sCouCat=&CountrySpecific_Category=-1&tab=RSKRT&Currency_ISO=&sortby=b_FundName&sortorder=ASC&Firstletter=&pageNo=' & intPageCount
                   
Call Societe(strAdresse, 'AL' & [AN65536].End(xlUp).Offset(4, -1).Row, strTableException)
             
Case 'Promoteurs'
                 
' Téléchargement Pour le courtTerme.
                  strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&tab=RSLTS&sortby=b_FundName&sortorder=ASC&Firstletter=&pageNo=' & intPageCount
                 
Call Societe(strAdresse, 'A' & [B65536].End(xlUp).Offset(5, -1).Row, '7')
                   
If intPageCount = intNbPage Then
                   
'Va chercher les infos de la société(étiquete)
                  strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&tab=RSLTS&sortby=b_FundName&sortorder=ASC&Firstletter=&pageNo=1'
                  Range('BA1:BL9').ClearContents
                     
Call Societe(strAdresse, 'BA1', '4')
                      Range('BA8:BE9').Copy Destination:=Range('BA7:BE8')
                      Range('BA2:BF8').Copy Destination:=Range('BA1:BF7')
                      Columns('BA:BF').EntireColumn.Hidden =
True
                      Application.ScreenUpdating =
True
                      Range('B8').Select
                   
End If
                 
' Téléchargement Pour le longTerme.
                  strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&tab=HSTRY&Firstletter=&pageNo=' & intPageCount & '&SortBy=b_FundName&sortorder=ASC'
                 
Call Societe(strAdresse, 'V' & [Y65536].End(xlUp).Offset(5, -1).Row, '7')
                 
' Téléchargement Pour les catégories et écarts types.
                  strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&tab=RSKRT&Firstletter=&pageNo=' & intPageCount & '&SortBy=b_FundName&sortorder=ASC'
                 
Call Societe(strAdresse, 'AL' & [AN65536].End(xlUp).Offset(8, -1).Row, '7')
             
Case 'Catégories'
                 
' Téléchargement Pour le courtTerme.
                  strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&search=&domicile=&countryspecific=&pageno=' & intPageCount
                 
Call Societe(strAdresse, 'A' & [B65536].End(xlUp).Offset(2, -1).Row, '4')
                 
' Téléchargement Pour le longTerme.
                  strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&search=&domicile=&countryspecific=&pageno=' & intPageCount
                 
Call Societe(strAdresse, 'W' & [Y65536].End(xlUp).Offset(2, -1).Row, '4')
                 
' Téléchargement Pour les catégories et écarts types.
                  strAdresse = 'URL; & tbltStrCompagnie(0, intCode) & '&search=&domicile=&countryspecific=&pageno=' & intPageCount
                 
Call Societe(strAdresse, 'AL' & [AM65536].End(xlUp).Offset(1, -1).Row, '4')
                 
       
End Select
        Application.StatusBar = 'Download de MorningStar pour ' & strChoix & ': ******* page Web ' & intPageCount & ' à ' & intNbPage & '*******'
   
Next intPageCount
    Application.StatusBar = 'Prêt'
   
Else
        MsgBox 'Désolé, il n'y a aucune information disponible sur ' & strAdresse
     
Exit Sub
 
End If
Next intCode


Private Function NbPage_All(Demande As String)
Dim Plus As Byte
Dim dblNbPageCalcul As Variant
If Demande = 'de ' Then
  Plus = 3
Else
  Plus = 4
End If
If InStr(Cells(60000, 2), 'No Results') = 0 And Cells(60000, 2) <> Empty Then
&nbsp; dblNbPageCalcul = Mid(Cells(60000, 2), InStr(Cells(60000, 2), Demande) + Plus, 10)
&nbsp; dblNbPageCalcul = Mid(dblNbPageCalcul, 1, InStr(1, dblNbPageCalcul, Chr(32)) - 1) / 30
&nbsp; NbPage_All = Application.WorksheetFunction.RoundUp(dblNbPageCalcul, 0)
Else
&nbsp; NbPage_All = -1
End If
End Function


Public Sub Societe(ByVal AdresseUlr As String, Destin As String, ByVal WebTab As String)
&nbsp; &nbsp; &nbsp;
'MsgBox (AdresseUlr)
&nbsp; &nbsp; &nbsp; On Error Resume Next
&nbsp; &nbsp; &nbsp;
With ActiveSheet.QueryTables.Add(Connection:=AdresseUlr, Destination:=Range(Destin))
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .WebFormatting = xlWebFormattingNone
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .WebTables = WebTab
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .Refresh BackgroundQuery:=
False
&nbsp; &nbsp; &nbsp;
End With
End Sub

voilà.

Donc remplace l'ancien code, par celui-ci et donne moi des nouvelles. et dis moi ce qui reste comme trouble encore. Merci !

ça achève mon gas !

a+
 

Statistiques des forums

Discussions
311 711
Messages
2 081 799
Membres
101 818
dernier inscrit
tiftouf5757