Accès fichier word depuis excel avec VBA

[recrue1905]

Bonjour à tous.
Je suis en pleine 'conception' de ma première macro sous excel et je
suis confronté au problème suivant: J'ai sur ma feuille un bouton qui
lance l'ouverture (en lecture seule) d'un fichier word et j'aimerais
récupérer le nom de ce fichier word dans mon fichier excel sous forme
de lien vers le fichier word sauvegardé par l'utilisateur. Voici un apercu
de ce que fait mon bouton pour le moment:

Sub Button_Click()
'definition
Dim FichierWord As Object
Set FichierWord = CreateObject("Word.Application")
' Création document
FichierWord.Documents.Add
' Sauvegarde
FichierWord.ActiveDocument.SaveAs "C:\User\My Documents\test.doc"
Set wordapp = CreateObject("Word.Application")
wordapp.Documents.Open "C:\User\My Documents\test.doc"
wordapp.Visible = True
' Fermeture
FichierWord.ActiveDocument.Close
Set FichierWord = Nothing
End Sub

Merci d'avance !
🙂

 

[PMO2]

Re : Accès fichier word depuis excel avec VBA

Bonjour,

J'ai traité 2 faces du problème.
Tout d'abord, dans votre classeur Excel créez une feuille "Liens" OU ALORS modifiez, à votre usage, la constante MA_FEUILLE cernée par des ###

1) CREATION D'UN NOUVEAU .DOC ET LIEN HYPERTEXTE DANS EXCEL
copiez le code suivant dans un module Standard

'### Nom de la feuille où les liens vont s'inscrire (à adapter) ###
Public Const MA_FEUILLE As String = "Liens"
'##################################################################

'*********** Lien hypertexte d'un nouveau fichier .doc **********
Sub NouveauDoc()
'definition
Dim S As Worksheet
Dim R As Range
Dim Lig&
Dim WordApp As Object 'Word.Application
Dim FichierWord As Object 'Word.Document
Dim chemin$
On Error Resume Next
Set S = ThisWorkbook.Sheets(MA_FEUILLE)
If S Is Nothing Then
  MsgBox "La feuille ''" & MA_FEUILLE & "'' est introuvable."
  Exit Sub
End If
On Error GoTo 0
' Instance Application Word
Set WordApp = CreateObject("Word.Application")

  '/// Pour visualisation de Word (inutile) ///
'WordApp.Visible = True
  '////////////////////////////////////
  
' Création document
Set FichierWord = WordApp.Documents.Add
' Inscrition d'un texte
FichierWord.Range.Text = "Bonjour à tous"
' Sauvegarde
chemin$ = "C:\test.doc"     'chemin à adapter
FichierWord.SaveAs chemin$
' Fermeture
FichierWord.Close
Set FichierWord = Nothing
WordApp.Quit
Set WordApp = Nothing
'### Lien hypertexte ###
Lig& = S.[a65536].End(xlUp).Row + 1
If S.[a1] = "" Then Lig& = 1
Set R = S.Range("a" & Lig& & "")
S.Hyperlinks.Add Anchor:=R, Address:=chemin$, _
    TextToDisplay:=Mid(chemin$, InStrRev(chemin$, "\") + 1)
Set R = R.Offset(0, 1)
R = chemin$
S.Cells.Columns.AutoFit
End Sub

2) LIEN HYPERTEXTE DANS EXCEL DE DOCUMENT WORD DEJA EXISTANT
copiez le code suivant dans un module Standard

'*********** Lien hypertexte d'un fichier .doc déjà existant **********
Sub DocExistant()
Dim S As Worksheet
Dim R As Range
Dim Lig&
Dim reponse
On Error Resume Next
Set S = ThisWorkbook.Sheets(MA_FEUILLE)
If S Is Nothing Then
  MsgBox "La feuille ''" & MA_FEUILLE & "'' est introuvable."
  Exit Sub
End If
On Error GoTo 0
reponse = Application.GetOpenFilename( _
  filefilter:="Documents Word (*.doc),*.doc", _
  Title:="Créer un lien hypertexte dans Excel")
If reponse = False Then Exit Sub
'### Lien hypertexte ###
Lig& = S.[a65536].End(xlUp).Row + 1
If S.[a1] = "" Then Lig& = 1
Set R = S.Range("a" & Lig& & "")
S.Hyperlinks.Add Anchor:=R, Address:=reponse, _
    TextToDisplay:=Mid(reponse, InStrRev(reponse, "\") + 1)
Set R = R.Offset(0, 1)
R = reponse
S.Cells.Columns.AutoFit
End Sub

Cordialement.

PMO
Patrick Morange

 

[recrue1905]

Re : Accès fichier word depuis excel avec VBA

Merci PMO2. Je viens de voir votre suggestion et je vais
m'empresser de l'essayer, même si je ne comprend pas
parfaitement.
Merci et bonne journée.
🙂