Ecrire en append un hyperlink dans word

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

Depuis ma VBA Excel, je créé un fichier Word dans lequel j'ajoute du texte. Mon souci est que ce texte doit être en "hyperlink" et surtout s'ecrire en append a chaque fois... Voici mon code :

Code:

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Sub Test()
 
    'Déclaration des variables
    Dim nom As String
    Dim NomDoc As String
    Dim Chemin As String
    Dim appWD As Word.Application
    Dim oDoc As Word.Document
 
    'Initialisatoion variables
    nom = "ListeLiens"
    NomDoc = nom & ".doc"
 
    'Vérification du nom pour etre sur qu'il n'est pas vide
    If Len(nom) = 1 Then
        MsgBox ""
        Exit Sub 'si la ligne ne contient ni nom ni prénom on quitte
    End If
 
    'On indique le dossier d'enregistrement du .doc
    Chemin = "P:\" & NomDoc
    On Error Resume Next
 
    'On créer l'objet et on vérifie sont existance
    Set appWD = CreateObject("Word.Application")
    If Err.Number <> 0 Then
        Set appWD = CreateObject("Word.Application")
    End If
    'On repart du début si erreur
    On Error GoTo 0
 
    'On vérifie que le chemin existe et on ouvre le document
    If Dir(Chemin) <> "" Then
        Set oDoc = appWD.Documents.Open(Chemin)
    Else
    'On ecrit dans le document
    Set oDoc = appWD.Documents.Add
        With oDoc
            With .Sections(1).Range
                .Font.Bold = True 'en gras
                .Font.Italic = True 'en italique
                .Text = "TATA"
                .InsertAfter vbLf & "TOTO "
                .Hyperlinks.Add Anchor:=.Sections(1).Last.Range, _
                    Address:="http://toto.com", _
                    ScreenTip:="totobulle", _
                    TextToDisplay:="totolink"
            End With
            .SaveAs Chemin
        End With
    End If
    appWD.Visible = True
    appWD.Activate
 
End Sub

J'ai essayé de réécrire cette ligne "Anchor:=.Sections(1).Last.Range" de la façon suivante : ".Hyperlinks.Add Anchor:=Sections(1).Range.End".

Bref cela ne fonctionne pas... J'ai un message d'erreur me disant que ce qui est écrit dans "Anchor" est faux. Le message d'erreur est :

Pièce jointe 381351

Si je change la ligne par ".Hyperlinks.Add Anchor:=.Sections(1).Range" alors cela fonctionne mais m'écrase les premières lignes saisies.

Avez-vous une solution s'il-vous-plaît ?

Bonjour,

Merci à ceux qui se sont penchés sur le sujet. De mon côté, je ne sais pas si c'est la meilleur solution mais voici ce que j'ai bidouiller pour que cela fonctionne :

Code:

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Sub Test()
 
    'Déclaration des variables
    Dim nom As String
    Dim NomDoc As String
    Dim Chemin As String
    Dim appWD As Word.Application
    Dim oDoc As Word.Document
 
    'Initialisatoion variables
    nom = "ListeLiens"
    NomDoc = nom & ".doc"
 
    'Vérification du nom pour etre sur qu'il n'est pas vide
    If Len(nom) = 1 Then
        MsgBox ""
        Exit Sub 'si la ligne ne contient ni nom ni prénom on quitte
    End If
 
    'On indique le dossier d'enregistrement du .doc
    Chemin = "C:\" & NomDoc
    On Error Resume Next
 
    'On créer l'objet et on vérifie sont existance
    Set appWD = CreateObject("Word.Application")
    If Err.Number <> 0 Then
        Set appWD = CreateObject("Word.Application")
    End If
    'On repart du début si erreur
    On Error GoTo 0
 
    'On vérifie que le chemin existe et on ouvre le document
    If Dir(Chemin) <> "" Then
        Set oDoc = appWD.Documents.Open(Chemin)
    Else
    'On ecrit dans le document
    Set oDoc = appWD.Documents.Add
        With oDoc
            With .Paragraphs(1).Range
                .Font.Bold = True 'en gras
                .Font.Italic = True 'en italique
                .Text = "TATA"
                .InsertAfter vbLf & "TOTO "
                .InsertAfter vbLf
                .Hyperlinks.Add Anchor:=.Paragraphs(3).Range, _
                    Address:="http://toto.com", _
                    ScreenTip:="totobulle", _
                    TextToDisplay:="totolink"
                .InsertAfter vbLf
                .Hyperlinks.Add Anchor:=.Paragraphs(4).Range, _
                    Address:="http://toto.com", _
                    ScreenTip:="totobulle", _
                    TextToDisplay:="totolink"
            End With
            .SaveAs Chemin
        End With
    End If
    appWD.Visible = True
    appWD.Activate
 
End Sub

J'ai rajouté un "vbLf" entre chaque lien et j'ai incrémenté mes numéros de paragraphes.

Salut

Hum, je n'ai pas d'avis sur la problématique de base mais
Code:

1 2 3 4 5 6 7 'Vérification du nom pour etre sur qu'il n'est pas vide If Len(nom) = 1 Then MsgBox "" Exit Sub 'si la ligne ne contient ni nom ni prénom on quitte End If
Len("") renvoie 0, len("a") renvoie 1
Pourquoi ne pas simplement tester si nom = "" ?

++
Qwaz