lien hypertexte vers onglets de classeurs fermés

[DavidSG]

Bonjour à tous,
J'ai vu sur ce forum des personnes très expérimentées sur Excel et je voulais faire appel à votre aide. Voila j'aimerais créer un classeur 'sommaire' dans lequel j'aurais une liste de liens hypertextes qui renverrait vers les onglets des autres classeurs fermés situés dans un meme répertoire. Bien sur mes classeurs comporte un nombre important d'onglets et j'aimerais que cela se fasse automatiquement. Est ce possible?

Merci de votre aide d'avance

En pièce jointe le type de classeur que j'aurais avec un sommaire pour chaque classeur. En fait j'aimerais le sommaire du sommaire.

 

[DavidSG]

Le fichier :

 

[DavidSG]

Mince

 

[DavidSG]

 

[MichelXld]

bonjour

ton fichier doit etre zippé , sans données confidentielles , de taille inferieure à 50 ko et sans caracteres speciaux dans le nom ( é , è , ç , à ...etc... )


ci joint un descriptif pour joindre un fichier

Lien supprimé


bonne journée
MichelXld

 

[DavidSG]

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

 

[DavidSG]

bonjour MichelXld, enfin j'y arrive..

Voila c'est ce fichier que j'ai avec plusieurs onglets et plusieurs classeurs comme celui ci. J'aimerais faire le sommaire des sommaire. C'est à dire un classeur semblable au sommaire de ce fichier mais pour tous les classeurs.

Merci

 

[MichelXld]

bonsoir

cette procédure boucle sur tous les classeurs fermés d'un repertoire , pour lister le nom des feuilles et créer un lien hypertexte vers chacun des onglets



Sub listeFeuillesClasseurFerme_creationLiens()
'necessite d'activer la reference Microsoft ActiveX Data Objects x.x Library
'necessite d 'activer la reference Microsoft ADO Ext 2.7 for DLL ans Security
'
'Dans l'editeur de macros :
'Menu Outils
'References
'Coche les 2 librairies citées ci dessus
'Clique sur OK pour valider
'
Dim Fichier As String, xConnect As String, Resultat As String
Dim Repertoire As String, Valeur As String
Dim Cat As ADOX.Catalog
Dim Cn As ADODB.Connection
Dim Feuille As ADOX.Table
Dim x As Integer

'adapter le chemin d urépertoire contenant les classeurs fermés
Repertoire = 'C:\\\\\\\\Documents and Settings\\\\\\\\michel\\dossier\\\\\\\\'

Fichier = Dir(Repertoire & '*.xls')

Do While Len(Fichier) › 0 'boucle sur les classeur du repertoire cible

xConnect = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' & Repertoire & Fichier & ';' & _
'Extended Properties=Excel 8.0;' 'preparation connection

Set Cat = CreateObject('ADOX.Catalog')
Set Cn = CreateObject('ADODB.Connection')
Cn.Open xConnect 'connection
Set Cat.ActiveConnection = Cn

For Each Feuille In Cat.tables 'boucle sur les feuilles et plages nommées des classeurs fermés

If Not InStr(1, Feuille.Name, '$', vbTextCompare) = 0 Then 'verification qu'il s'agit d'une feuille
Resultat = Application.WorksheetFunction.Substitute(Feuille.Name, '$', '')
Valeur = Application.WorksheetFunction.Substitute(Resultat, ''', '')

x = Worksheets(1).Range('A65536').End(xlUp).Row + 1 'recupere la 1ere ligne vide dans la feuille de creation des liens
'creation du lien
Worksheets(1).Hyperlinks.Add Anchor:=Sheets('Bilan').Cells(x, 1), _
Address:=Repertoire & Fichier, SubAddress:=''' & Valeur & ''!A1', _
TextToDisplay:=Fichier & ' ' & Valeur

End If

Next Feuille

Cn.Close
Set Cn = Nothing
Set Cat = Nothing

Fichier = Dir()
Loop
End Sub



bonne soirée
MichelXld

 

[DavidSG]

Merci Merci Infiniement pour le travail que tu as effectué MichelXld. C'est exactement ce que je veux.
Cependant quand je lance la macro que tu m'a proposé cela me fait rien.
Peut être est ce du à l'activation de la référence Microsoft ActiveX Data Objects x.x Library
que je ne trouve pas, je l'ai remplacé par Microsoft ActiveX Data Objects 2.0 Library. Je le trouve assez semblable. Penses tu que le problème viens de là?

Merci d'avance
David

 

[MichelXld]

bonjour David

quand j'écris Microsoft ActiveX Data Objects x.x Library ; xx.x dépend de la version installée sur ton poste . cela peut aller de 2.0 à 2.8

sinon quand tu dis que cela ne fait rien : les liens ne sont pas créés ? ( j'ai testé la procédure avec OfficeXP


bon week end
MichelXld

 

[DavidSG]

Bonjour MichelXld,

J'ai essayé toute les versions du Microsoft ActiveX Data Objects x.x Library installés (du 2.0 au 2.7) sur mon poste et cela ne fonctionne toujours pas (aucun lien n'est créé, rien ne se passe).

Je suis sous office2000. J'essaierais ce we sur officeXP si je l'ai.

Sinon peux tu joindre au message le zip contenant quelques classeurs et des onglets et le classeur création de liens onglets contenant la macro. Cela pourras toujours servir aux autres même si je n'y arrive pas.

Merci beaucoup et bon WE

David

 

[MichelXld]

bonsoir David

j'espere que cet exemple pourra t'aider


bonne soirée
MichelXld [file name=listeFeuillesClasseurFerme_creationLiens.zip size=13596]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/listeFeuillesClasseurFerme_creationLiens.zip[/file]

 

[DavidSG]

Re:lien hypertexte vers onglets de classeurs fermé

Bonjour MichelXld,
C'est super ca marche! Merci mille fois, tu m'as rendu un grand service.

bonne journée
David

 

[DavidSG]

Bonjour le forum, MichelXld

La procédure me crée des liens vers des onglets qui n'existe pas. Il me rajoute un lien vers un onglets 'zone d'impression' en plus de l'onglet normal. (ex : classeur.xls onglet_zone d'impression)
Savez vous d'ou cela peut provenir?

Merci
David

 

[MichelXld]

bonsoir

cela fait malheureusement partie de limites de la méthode
comme je l'ai indiqué dans le message du 05 Avril :

For Each Feuille In Cat.tables 'boucle sur les feuilles et plages nommées des classeurs fermés

je ne vois pas de solution sinon de tester si le nom contient la chaine de caracteres 'Zone_d_impress'

If Not InStr(1, Feuille.Name, '$', vbTextCompare) = 0 And _
InStr(1, Feuille.Name, 'Zone_d_impress', vbTextCompare) = 0 Then 'verification qu'il s'agit d'une feuille



bonne soirée
MichelXld

Message édité par: michelxld, à: 10/04/2006 19:25