sélection par catégories et par fonds

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)
http://www.morningstar.fr/benchmark/benchmark.asp?tab=OVRVW&sortby=b_FundName&SortOrder=ASC&GraphCid=&GraphFundNames=&MSCategory_ID=115

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
 

Hellboy

XLDnaute Accro
Bonjour Sylvain


Je manque de temps pour élaborer(au boulot), mais ce soir j'aurai un peu de temps pour regarder ce que tu demande. Pourrais-tu svp envoyer le fichier sur cjoint.

Merci !

a+
 

lebarbo

XLDnaute Occasionnel
re,

j'ai mis le fichier sur mon serveur :
Ce lien n'existe plus

Bonne journée et merci
a+

Message édité par: lebarbo, à: 01/08/2005 18:45
 

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;http://www.morningstar.fr/companies/default.aspx?lang=fr-FR&country=FR&tab=RSLTS&sortby=b_FundName&sortorder=ASC&firstletter=&mec=' & 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;http://www.morningstar.fr/companies/default.aspx?lang=fr-FR&country=FR&tab=RSLTS&sortby=b_FundName&sortorder=ASC&firstletter=&mec=' & 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;http://www.morningstar.fr/companies/default.aspx?lang=fr-FR&country=FR&tab=HSTRY&sortby=b_FundName&sortorder=ASC&firstletter=&mec=' & 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;http://www.morningstar.fr/companies/default.aspx?lang=fr-FR&country=FR&tab=RSKRT&sortby=b_FundName&sortorder=ASC&firstletter=&mec=' & 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;http://www.morningstar.fr/benchmark/benchmark.asp?curiso=EUR&univ=FR1&lang=FR&country=FR&MSCategory_ID=' & 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;http://www.morningstar.fr/benchmark/benchmark.asp?curiso=EUR&univ=FR1&lang=FR&country=FR&MSCategory_ID=' & 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/fundselect/result.aspx?lang=fr-FR&country=FR&tab=RSLTS&sortby=b_FundName&sortorder=ASC&firstletter=&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/fundselect/result.aspx?lang=fr-FR&country=FR&tab=HSTRY&sortby=b_FundName&sortorder=ASC&firstletter=&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/fundselect/result.aspx?lang=fr-FR&country=FR&tab=RSKRT&sortby=b_FundName&sortorder=ASC&firstletter=&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;http://customer.morningstareurope.com/FR/skandia/website/asp/quickrankfrenchSkandia.asp?sMEC=&FundCategory_Id=-1&lMSCategory_Id=-1&sSearch=&sFCCurrency_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;http://customer.morningstareurope.com/FR/skandia/website/asp/quickrankfrenchSkandia.asp?sMEC=&FundCategory_Id=-1&lMSCategory_Id=-1&sSearch=&sFCCurrency_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;http://customer.morningstareurope.com/FR/skandia/website/asp/quickrankfrenchSkandia.asp?sMEC=&FundCategory_Id=-1&lMSCategory_Id=-1&sSearch=&sFCCurrency_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;http://www.morningstar.fr/promoteurs/index.asp?search=&Promoteur_Id=' & 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;http://www.morningstar.fr/promoteurs/index.asp?search=&Promoteur_Id=' & 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;http://www.morningstar.fr/promoteurs/index.asp?search=&Promoteur_Id=' & 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;http://www.morningstar.fr/promoteurs/index.asp?search=&Promoteur_Id=' & 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;http://www.morningstar.fr/quickrank/default.aspx?lang=fr-FR&country=FR&tab=RSLTS&sortby=b_FundName&sortorder=ASC&firstletter=&mec=&cat=' & 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;http://www.morningstar.fr/quickrank/default.aspx?lang=fr-FR&country=FR&tab=HSTRY&sortby=b_FundName&sortorder=ASC&firstletter=&mec=&cat=' & 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;http://www.morningstar.fr/quickrank/default.aspx?lang=fr-FR&country=FR&tab=RSKRT&sortby=b_FundName&sortorder=ASC&firstletter=&mec=&cat=' & 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+
 

lebarbo

XLDnaute Occasionnel
re,

c'est bon la nouvelle liste est présente :
nouveau fichier

Ce lien n'existe plus

PS : pour la refonte du fichier je le ferais quand tout sera bon.
 

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;http://www.morningstar.fr/companies/default.aspx?lang=fr-FR&country=FR&tab=RSLTS&sortby=b_FundName&sortorder=ASC&firstletter=&mec=' & 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;http://www.morningstar.fr/companies/default.aspx?lang=fr-FR&country=FR&tab=RSLTS&sortby=b_FundName&sortorder=ASC&firstletter=&mec=' & 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;http://www.morningstar.fr/companies/default.aspx?lang=fr-FR&country=FR&tab=HSTRY&sortby=b_FundName&sortorder=ASC&firstletter=&mec=' & 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;http://www.morningstar.fr/companies/default.aspx?lang=fr-FR&country=FR&tab=RSKRT&sortby=b_FundName&sortorder=ASC&firstletter=&mec=' & 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;http://www.morningstar.fr/benchmark/benchmark.asp?curiso=EUR&univ=FR1&lang=FR&country=FR&MSCategory_ID=' & 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;http://www.morningstar.fr/benchmark/benchmark.asp?curiso=EUR&univ=FR1&lang=FR&country=FR&MSCategory_ID=' & 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/fundselect/result.aspx?lang=fr-FR&country=FR&tab=RSLTS&sortby=b_FundName&sortorder=ASC&firstletter=&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/fundselect/result.aspx?lang=fr-FR&country=FR&tab=HSTRY&sortby=b_FundName&sortorder=ASC&firstletter=&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/fundselect/result.aspx?lang=fr-FR&country=FR&tab=RSKRT&sortby=b_FundName&sortorder=ASC&firstletter=&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;http://customer.morningstareurope.com/FR/skandia/website/asp/quickrankfrenchSkandia.asp?sMEC=&FundCategory_Id=-1&lMSCategory_Id=-1&sSearch=&sFCCurrency_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;http://customer.morningstareurope.com/FR/skandia/website/asp/quickrankfrenchSkandia.asp?sMEC=&FundCategory_Id=-1&lMSCategory_Id=-1&sSearch=&sFCCurrency_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;http://customer.morningstareurope.com/FR/skandia/website/asp/quickrankfrenchSkandia.asp?sMEC=&FundCategory_Id=-1&lMSCategory_Id=-1&sSearch=&sFCCurrency_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;http://www.morningstar.fr/promoteurs/index.asp?search=&Promoteur_Id=' & 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;http://www.morningstar.fr/promoteurs/index.asp?search=&Promoteur_Id=' & 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;http://www.morningstar.fr/promoteurs/index.asp?search=&Promoteur_Id=' & 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;http://www.morningstar.fr/promoteurs/index.asp?search=&Promoteur_Id=' & 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;http://www.morningstar.fr/quickrank/default.aspx?lang=fr-FR&country=FR&tab=RSLTS&sortby=b_FundName&sortorder=ASC&firstletter=&mec=&cat=' & 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;http://www.morningstar.fr/quickrank/default.aspx?lang=fr-FR&country=FR&tab=HSTRY&sortby=b_FundName&sortorder=ASC&firstletter=&mec=&cat=' & 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;http://www.morningstar.fr/quickrank/default.aspx?lang=fr-FR&country=FR&tab=RSKRT&sortby=b_FundName&sortorder=ASC&firstletter=&mec=&cat=' & 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+
 

lebarbo

XLDnaute Occasionnel
attend 30s je rédige c'est compliqué lol

Message édité par: lebarbo, à: 02/08/2005 18:10
 

lebarbo

XLDnaute Occasionnel
Bonjour Hellboy,

je viens de finir les test voici les résultats :unsure: :

Quand je télécharge 10000 essai :
Sociétés : 'désolé...' Ok
Promoteurs : 'désolé...' Ok
Catégories : 'désolé...' Ok
Catégories (%act. oblig. cash) : 'désolé...' Ok

Si je retélécharge juste après :

Sociétés : bug -> bytColumnRef = Cells(9, 1).End(xlToRight).Column
Promoteurs : Ok
Catégories : bug -> ça plante
Catégories (%act. oblig. cash) : bug -> bytColumnRef = Cells(9, 1).End(xlToRight).Column

-------------------------------------------------
Si maintenant sans télécharger 10000 essai je télécharge une page de moins de 30 fonds (donc une seule page) :

Sociétés : bug -> bytColumnRef = Cells(9, 1).End(xlToRight).Column
Promoteurs : Ok
Catégories : ça plante
Catégories (%act. oblig. cash) : bug -> bytColumnRef = Cells(9, 1).End(xlToRight).Column

-------------------------------------------------

Si maintenant sans télécharger 10000 essai je télécharge une page de plus de 30 fonds (donc plusieurs pages) :

Sociétés : bug -> bytColumnRef = Cells(9, 1).End(xlToRight).Column
Promoteurs : Ok
Catégories : ça plante
Catégories (%act. oblig. cash) : bug -> affichage de 'désolé...'


le code que j'ai inséré d'après MSN :
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 And InStr(Cells(60000, 2), Demande & 0) = 0 Then
dblNbPageCalcul = Mid(Cells(60000, 2), InStr(Cells(60000, 2), Demande) + Plus, 10)
If IsNumeric(Trim(dblNbPageCalcul)) Then
dblNbPageCalcul = Mid(dblNbPageCalcul, 1, InStr(1, dblNbPageCalcul, Chr(32)) - 1) / 30
NbPage_All = Application.WorksheetFunction.RoundUp(dblNbPageCalcul, 0)
Else
NbPage_All = -1
End If
Else
NbPage_All = -1
End If

End Function


Voilà j'espère que ça pourra t'éclairer moi je vais regarder mais je doute d'y arriver :eek: On va voir ;)

Bye
 

Hellboy

XLDnaute Accro
re

Je suis débordé aujourd'hui, mais j'ai pris le temsp de voir ce qui clochait. Alors la tout un BUG. Je te donne le résumé!

FundName Ceci est ds le code et se retrouve ds l'adresse et représente la bonne nomenclature.

Fund Name avec un espace n'est pas , pas du tout recommandable. :) C'est ça qui fait qu'il n'y avait rien ds les page. pour certaine option, sinon tous.


Donc remplace tout les Fund Name par FundName.

ensuite remplace le code de la fonction page par celui-ci:


Option Explicit
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)
If IsNumeric(Trim(dblNbPageCalcul)) Then
  dblNbPageCalcul = Mid(dblNbPageCalcul, 1, InStr(1, dblNbPageCalcul, Chr(32)) - 1) / 30
  NbPage_All = Application.WorksheetFunction.RoundUp(dblNbPageCalcul, 0)
Else
  NbPage_All = -1
End If

End Function

J'essairer de revenir plus tard.

connect sur msn, va aller plus vite

a+

Message édité par: Hellboy, à: 03/08/2005 14:25
 

lebarbo

XLDnaute Occasionnel
re,

je suis emmerdé je viens de passer une heure dessus et là je suis à cours de temps.

Je t'explique le téléchargement de catégories(%actions...) merde sur certaines catégories et pas sur danemark :eek: :eek: :eek:

Sinon pour le bug de 1000 essai ça ne marche pas sur catégories et du coup moyennement sur catégories (%actions...)

Sinon pour 'Option explicit' ça ne marchais pas donc je l'ai enlevé

je te mets le fichier et désolé :eek: de te donner que ces seuls éléments je pourrais m'y remettre que demain.

Le fichier
Ce lien n'existe plus

Message édité par: lebarbo, à: 03/08/2005 17:52
 

lebarbo

XLDnaute Occasionnel
Bonjour Hellboy,

J'ai fait un fichier PLUS9 qui est pour l'instant celui qui marche le mieux. Pour le code 'private' j'ai mis celui-là :

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)
If IsNumeric(Trim(dblNbPageCalcul)) Then
dblNbPageCalcul = Mid(dblNbPageCalcul, 1, InStr(1, dblNbPageCalcul, Chr(32)) - 1) / 30
NbPage_All = Application.WorksheetFunction.RoundUp(dblNbPageCalcul, 0)
Else
NbPage_All = -1
End If

End Function

Après 1h30 de tests :) voici mes résultats sur les erreurs constatés :

Pour Catégories :

- il y a une erreur quand on veut télécharger une page qui n'existe pas (10000 essai) le bug étant à cette ligne :
bytColumnRef = Cells(9, 1).End(xlToRight).Column
La page devient inutilisable après ce bug.

- Lorsqu'on veut télécharger sans connection tout fonctionne nikel : message= 'désolé...' la page est utilisable après donc il faut peut-être creusé sur cette partie.

Pour Catégories (% act. oblig. cash) :

- là c'est chelou :eek: quand on veut télécharger une catégorie contenant plus de 30 fonds donc avec une deuxième page il inscrit le message 'désolé...'

- si par contre on test sans connection ou en téléchargeant une page inexistante (10000 essai) et qu'on télécharge une catégorie avec moins de 30 fonds c'est Ok tout se passe comme il faut. Si on essaye avec une catégorie > à 30 fonds : même problème que précedemment : affichage 'désolé...'

=> Pour tout le reste, toutes les autres feuilles j'ai testé toutes les possibilités (il me semble...) et rien à dire tout est impeccable ;)

Voilà je regarde à nouveau pour voir si je peux débuguer tout ça et je te mets le fichier :
Ce lien n'existe plus

Bye et merci d'avance

Message édité par: lebarbo, à: 04/08/2005 10:46
 

Hellboy

XLDnaute Accro
re
Excuse moi, je viens de voir que mon msn étais resté connaecter au travail.
Ce matin je te parlais de la maison.

Tu me donne des nouvelles si ça été mieux avec le code que je t'ai donné. !

Merci !

A+
 

lebarbo

XLDnaute Occasionnel
re,

ok pas de soucis, le code marche au poil :woohoo: :woohoo: :woohoo: :woohoo: :woohoo: :woohoo: :woohoo: :woohoo:
lol

Je te remerciiiiiiiiiiiiiiiiiiiiiiiiiii beaucouuuuuuuuuuup

Je suis en train de faire la refonte du logiciel ça va assez vite en effet et il est beaucoup moins gros :) ;)

après je vais faire tous les test.

Bye
a+
 

lebarbo

XLDnaute Occasionnel
Il n'y a plus qu'un truc qui m'emmerde d'ailleurs je ne sais pas pourquoi :eek: c'est au niveau de la mise en forme, j'ai mis la feuille en motif blanc (donc sans cadre gris) et quand il télécharge il m'en remet un. :eek:

et un autre petit soucis mais que je ne sais pas faire pour la phrase d'erreur je voudrais mettre :

MsgBox 'Votre requête ne peut aboutir. Vérifiez que vous êtes connecté puis réitérez votre demande ou aucune information est disponible sur ' & strAdresse, vbExclamation, 'Requête impossible'

Et que ça apparaisse comme ça :

Votre requête ne peut aboutir. Vérifiez que vous êtes connecté puis réitérez votre demande
OU
Aucune information est disponible sur ' & strAdresse

mais je ne sais pas faire les saut de ligne en code :ermm: :unsure: :eek:

Message édité par: lebarbo, à: 04/08/2005 16:06
 

Discussions similaires


Haut Bas