Question

这是我到目前为止所拥有的：）

我要做的是将文件路径和文件名添加到word文档的页脚中，该文件是从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

以下是您在页脚中编写文档名称的功能，您可以根据需要进行扩展。

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

你的问题不清楚。

如果您需要在文件中包含 Word 文档的名称，则必须先将其保存（并且必须为其命名）。

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

如果您需要在文件中包含 Excel 工作簿的文件路径/名称，那么您只需要引用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

然而，就个人而言，我不是每次调用宏时都是从头开始构建文档，而是创建模板，以ReadOnly模式打开文档，并使用find和replace来替换任何动态数据。实施例

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

如何使用VBA将文件名添加到页脚？

2 个答案: