Comment utiliser VBA pour ajouter le nom de fichier dans le pied de page?

Question

Voici ce que j'ai jusqu'à présent :)

Ce que je suis en train de faire est d'ajouter le chemin du fichier et le nom du fichier dans le pied de page dans le document Word, qui est en cours de création à partir d'Excel ...

Function ReportTypeC() 

Dim wdApp As Word.Application 
Dim wb As Workbook 
Dim SrcePath As String 
Dim FileName As String 

FileName = ActiveDocument.FullName 

SrcePath = "L:\TEST\Archive\unnamed.jpg" 

Set wdApp = New Word.Application 

With wdApp 
    .Visible = True 
    .Activate 

    .Documents.Add 
    Application.CutCopyMode = False 

    .ActiveDocument.Sections.Item(1).Headers(wdHeaderFooterPrimary) _ 
     .Range.InlineShapes.AddPicture (SrcePath) 

    .ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary) _ 
    .PageNumbers.Add PageNumberAlignment:=wdAlignPageNumberLeft, FirstPage:=True 

    'With ActiveDocument.Sections(1) 
     '.Footers(wdHeaderFooterPrimary).Range.Text = "FileName" 
    'End With 
End With 

End Function 

Answer 1

Voici votre fonction pour écrire le nom du document dans le pied de page que vous pouvez étendre selon vos besoins.

Option Explicit 

Function ReportTypeC() 

Dim wdApp As Word.Application 
Set wdApp = CreateObject("Word.Application") 
wdApp.Visible = True 
wdApp.Documents.Add 

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter 
Selection.TypeText Text:=ThisWorkbook.Path & thisworkbook.Name & ".docx" 
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 

appWD.ActiveDocument.SaveAs Filename:=ThisWorkbook.Path & thisworkbook.Name & ".docx" 
wdApp.ActiveDocument.Close 
wdApp.Quit 
End Function 

Answer 2

Votre question est claire.

Si vous avez besoin du fichier Word dans le fichier, vous devez d'abord le sauvegarder (et vous devez lui donner un nom).

Sub ReportTypeC() 

    Dim wdApp As New Word.Application 
    Dim wdDoc as Word.Document 
    Dim SrcePath As String 
    Dim FileName As String 

    SrcePath = "L:\TEST\Archive\unnamed.jpg" 

    With wdApp 
     .Visible = True 
     .Activate 
     Set wdDoc = .Documents.Add 
    End With 

    'Build your file path and file name here; I am using ThisWorkbook assuming we are exporting to the same directory as the workbook, and calling the exported document "mydocument.docx" 
    FileName = ThisWorkbook.Path & "\" & "mydocument.docx" 

    With wdDoc 
    .SaveAs FileName:=FileName 
    With .Sections(1) 
     .Headers(wdHeaderFooterPrimary).Range.InlineShapes.AddPicture SrcePath 
     .Footers(wdHeaderFooterPrimary).PageNumbers.Add PageNumberAlignment:=wdAlignPageNumberLeft, FirstPage:=True 
     .Footers(wdHeaderFooterPrimary).Range.Text = FileName 
    End With 
    .Save 
    End With 

End Sub 

Si vous avez besoin d'avoir le filepath de classeur Excel /nom dans le fichier, il vous suffit de se référer à l'objet ThisWorkbook et sa propriété FullName.

Sub ReportTypeC() 

    Dim wdApp As New Word.Application 
    Dim wdDoc as Word.Document 
    Dim SrcePath As String 

    SrcePath = "L:\TEST\Archive\unnamed.jpg" 

    With wdApp 
     .Visible = True 
     .Activate 
     Set wdDoc = .Documents.Add 
    End With 

    With wdDoc 
     With .Sections(1) 
      .Headers(wdHeaderFooterPrimary).Range.InlineShapes.AddPicture SrcePath 
      .Footers(wdHeaderFooterPrimary).PageNumbers.Add PageNumberAlignment:=wdAlignPageNumberLeft, FirstPage:=True 
      .Footers(wdHeaderFooterPrimary).Range.Text = ThisWorkbook.FullName 
     End With 
     .Save 
    End With 

End Sub 

Personnellement, cependant, au lieu de construire le document à partir de zéro chaque fois que j'appelle la macro, je voudrais créer un modèle, ouvrez le document en mode lecture seule, et utiliser Rechercher et remplacer pour remplacer toute dynamique données . Exemple

Sub ReportTypeC() 

    Dim wdApp As New Word.Application 
    Dim wdDoc as Word.Document 
    Dim SrcePath As String 
    Dim FileName As String 
    Dim wdRange as Word.Range 
    Const TemplatePath as String = "L:\TEST\Archive\Report C template.docx" ' This template contains the text "{{ FileName }}" and "{{ SourceWorkbook }}" in the footer, which is to be replaced. 

    SrcePath = "L:\TEST\Archive\unnamed.jpg" 

    With wdApp 
     .Visible = True 
     .Activate 
     Set wdDoc = .Documents.Open(FileName:=TemplatePath, ReadOnly:=True) 
    End With 

    ' Exported file 
    FileName = "L:\TEST\Archive\" & "Report C " & Format(Now, "yyyy-mm-dd") & ".docx" ' e.g. "Report C 2017-09-27.docx" 

    With wdDoc 
     With .Sections(1).Footers(wdHeaderFooterPrimary) 
      ' If we are sure that the template contains "{{ SourceWorkbook }}"), we can work with the range directly 
      FindRange(.Range, "{{ SourceWorkbook }}").Text = ThisWorkbook.FullName 
      ' If we aren't sure whether the template contains "{{ FileName }}" we need to check there's a match, so it doesn't replace the whole footer range 
      Set wdRange = FindRange(.Range, "{{ FileName }}") 
      If wdRange.Text = "{{ FileName }}" Then wdRange.Text = FileName 
     End With 
     ' Save the file 
     .SaveAs FileName:=FileName 
    End With 

End Sub 

Function FindRange(ByRef rLook As Word.Range, ByVal strFind As String) As Word.Range ' returns the first range that is matched by the strFind string 
    rLook.Find.Execute Findtext:=strFind, MatchCase:=True, Forward:=True, Wrap:=wdFindStop, MatchWholeWord:=True 
    Set FindRange = rLook 
End Function