Discussion :

[outlaw971]

Bonjour les amis
je suis un nouveau membre du forum.
j'utilise Excel 2003
--------------------------------------------------
Je voudrais à l'aide d'une macro, imprimer
des feuilles contenues dans des classeurs
externes, qui sont reliées à mon classeur grâce
à des liens Hypertexte.
--------------------------------------------------
En gros, quand on clic sur une cellule ça va imprimer
les liens hypertexte de la cellule situé 3 cellules plus
loin sur la même ligne.
--------------------------------------------------
ma macro me donne cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 Sub impression()
    ActiveWindow.SmallScroll Down:=-9
    Range("H2").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Dim nb As Integer
nb = Val(InputBox("Donner un nombre de copie : "))
If nb = 0 Then Exit Sub
ActiveWindow.SelectedSheets.PrintOut Copies:=nb, Collate:=True
    ActiveWindow.Close
    Range("I2").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
nb = Val(InputBox("Donner un nombre de copie : "))
If nb = 0 Then Exit Sub
ActiveWindow.SelectedSheets.PrintOut Copies:=nb, Collate:=True
    ActiveWindow.Close
    Range("J2").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    ActiveWindow.Close
    Range("K2").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    ActiveWindow.Close
End Sub

Merci d'avance pour votre aide

[James007]

Bonjour,

Le plus simple ... une boucle ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Dim HypLnk As Variant 
For Each HypLnk In ActiveSheet.Hyperlinks
....

A +

[James007]

Ta macro a été enregistrée par le "macro recorder" sans modification ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
Sub impression()
    ActiveWindow.SmallScroll Down:=-9
    ActiveCell.Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Dim nb As Integer
nb = Val(InputBox("Donner un nombre de copie : "))
If nb = 0 Then Exit Sub
ActiveWindow.SelectedSheets.PrintOut Copies:=nb, Collate:=True
    ActiveWindow.Close
    ActiveCell.Offset(0,1).Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
nb = Val(InputBox("Donner un nombre de copie : "))
If nb = 0 Then Exit Sub
ActiveWindow.SelectedSheets.PrintOut Copies:=nb, Collate:=True
    ActiveWindow.Close
    ActiveCell.Offset(0,2).Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    ActiveWindow.Close
    ActiveCell.Offset(0,3).Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    ActiveWindow.Close
End Sub

A tester ...

[outlaw971]

çà y est j'ai trouvé

Merci M. Bond

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub impression()
 
 
    ActiveWindow.SmallScroll Down:=-9
    ActiveCell.Offset(0, 1).Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Dim nb As Integer
nb = Val(InputBox("Donner un nombre de copie : "))
If nb = 0 Then Exit Sub
ActiveWindow.SelectedSheets.PrintOut Copies:=nb, Collate:=True
    ActiveWindow.Close
    ActiveCell.Offset(0, 1).Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
nb = Val(InputBox("Donner un nombre de copie : "))
If nb = 0 Then Exit Sub
ActiveWindow.SelectedSheets.PrintOut Copies:=nb, Collate:=True
    ActiveWindow.Close
    ActiveCell.Offset(0, 1).Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    ActiveWindow.Close
    ActiveCell.Offset(0, 1).Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    ActiveWindow.Close
End Sub