plusieurs Excel via lien hypertexte

[la lozere]

Bonjour,
Voilà, j'ai un fichier Excel qui, quand je l'ouvre, s'affiche en plein écran (plus rien, barres d'outils, barres de défilements, etc.).
Ce fichier Excel contient un bouton permettant de quitter sans sauvegarder ainsi que des liens hypertextes vers d'autres fichiers Excel.
Et donc mon souci vient quand je clic sur ces liens hypertexte. Ces nouveaux documents s'ouvrent aussi en plein écran ce qui n'est pas voulu et ensuite si je clic sur le bouton de fermeture du premier fichier, tous les documents ouverts sont quittés sans être sauvegardés,ce qui présente un risque.

Ainsi, ce que je voudrais, c'est que dans mon premier fichier, il y est un paramètre qui force l'ouverture de ces fichiers, via lien hypertexte, dans un nouveau "Programme Excel".
Bref comme si je lançais plein d'Excel pour ouvrir tous mes fichiers. Qui, du coup seraient indépendants et en affichage normal.

Je vous joins un exemple avec un fichier "Base.xls" contenant toutes les macro et un lien hypertexte vers le fichier "test.xls"

Je ne sais pas si j'ai été clair, mais merci d'avance.

 

[mromain]

Re : plusieurs Excel via lien hypertexte

bonjour la lozere,

voici un essai (code à mettre sur la feuille, clic droit sur l'onglet > visualiser le code)

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim tabStr() As String, appExcel As Excel.Application

tabStr = Split(Target.Address, "\")

Application.ScreenUpdating = False

'fermer le classeur ouvert par le lien
Application.Workbooks(tabStr(UBound(tabStr))).Close False

'créer une nouvelle application Excel
Set appExcel = New Excel.Application
With appExcel
    .Visible = True
    'ouvrir le classeur du lien
    .Workbooks.Open ThisWorkbook.Path & "\" & Target.Address
End With

Application.ScreenUpdating = True

End Sub

a+

 

[la lozere]

Re : plusieurs Excel via lien hypertexte

Je ne dirais qu'une chose PARFAIT.
Exactement ce que je veux.
Merci mromain

 

[la lozere]

Re : plusieurs Excel via lien hypertexte

Comme je l'ai dit, ce petit bout de code marche à la perfection.
Sauf que si j'ai un lien hypertexte non pas vers un fichier excel mais un fichier word, j'ai une erreur VBA:

"Erreur d'exécution '9':
L'indice n'appartient pas à la sélection.

Et l'erreur vient de la ligne:

Application.Workbooks(tabStr(UBound(tabStr))).Close False

Quelqu'un aurait une idée pour corriger ce petit bug.

Je joins un zip avec un fichier base.xls avec 2 liens:
- 1 vers un fichier xls, et là pas de soucis,
- 1 vers un fichier doc, et là, problème.

Merci.

 

[mromain]

Re : plusieurs Excel via lien hypertexte

bonjour la lozere,

voici la macro modifiée :

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim tabStr() As String, appExcel As Excel.Application

tabStr = Split(Target.Address, "\")

[COLOR=Red][B]If UCase(Right(Target.Address, 3)) <> "XLS" Then Exit Sub
[/B][/COLOR]
Application.ScreenUpdating = False

'fermer le classeur ouvert par le lien
Application.Workbooks(tabStr(UBound(tabStr))).Close False

'créer une nouvelle application Excel
Set appExcel = New Excel.Application
With appExcel
    .Visible = True
    'ouvrir le classeur du lien
    .Workbooks.Open ThisWorkbook.Path & "\" & Target.Address
End With

Application.ScreenUpdating = True

End Sub

 

[la lozere]

Re : plusieurs Excel via lien hypertexte

Merci,
t'es un chef.
A plus.

 

[la lozere]

Re : plusieurs Excel via lien hypertexte

Salut mromain,
Puis-je abuser?
Ton bout de code ajouté marche impec, mais uniquement avec des XLS.
Or moi j'ai aussi des XLSM, XLSX. Office 2007 oblige. Et dans ces cas, il ne m'ouvre pas un nouvel Excel.
J'ai testé 2-3 truc mais cela ne marche pas.
A plus.

 

[la lozere]

Re : plusieurs Excel via lien hypertexte

J'ai trouvé comme un grand....

j'ai modifié:

[COLOR="Red"]If UCase(Right(Target.Address, 3)) <> "XLS" Then Exit Sub[/COLOR]

Par:

[COLOR="Red"]If (Application.Or(UCase(Right(Target.Address, 4)) = "DOTX", UCase(Right(Target.Address, 3)) = "DOT", UCase(Right(Target.Address, 3)) = "DOC", UCase(Right(Target.Address, 4)) = "DOCM", UCase(Right(Target.Address, 4)) = "DOCX")) Then Exit Sub[/COLOR]

A plus.