sélection par catégories et par fonds

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

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

Bonjour lebardo

Ça sent le serveu roussis. Bravo, pour ta trouvaille

Est-ce qu'il y a quelque chose que je peux faire ?

Je suis sur MSN la !

a+

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à.

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

Cliquez pour agrandir...

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

a+

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

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

Cliquez pour agrandir...

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

Cliquez pour agrandir...

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

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+

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

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 si tu m'as mal compris dis le moi.

Encore merci pour ton aide précieuse.

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

Cliquez pour agrandir...

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

Cliquez pour agrandir...

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

a+

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 inch: :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 lol

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

Bye a+

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.

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

Cliquez pour agrandir...

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

Cliquez pour agrandir...

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

Cliquez pour agrandir...

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+

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

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