VBAを使用してフッターにファイル名を追加するにはどうすればよいですか？ここ

Question

は、私がこれまで持っているものです:)

私がやろうとしていますどのようなExcelから作成されたWord文書内のフッターにファイルパスとファイル名を追加することです...

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

フッターに書かれた文書名のための機能は、あなたの必要性に合わせて拡張することができます。

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

あなたの質問は不明です。

ワード文書の名前をファイルに保存する必要がある場合は、ファイルの名前を最初に保存する必要があります（名前を付ける必要があります）。

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 

ファイルにエクセルワークブックのファイルパス/名前を持つ必要がある場合は、あなただけThisWorkbookオブジェクトとその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 

個人的に、しかし、ではなく、最初から私はマクロを呼び出すたびに文書を構築、私は、テンプレートを作成して読み取り専用モードでドキュメントを開き、任意のダイナミックデータを交換するために検索と置換を使用します。例

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