将 Excel 单元格数据写入 Word 文档不一致

问：

下面是我的 Word 模板、我的 VBA 代码和我的输出。我的问题是有些输出行是正确的，而有些则不正确。我做错了什么？

这是我的 Word 模板：

[Art Source]
[Day]
[Scripture]
[Title], [Created]
[Creator], [Country], [Life]
[Medium], [Size]
[Location], [City]

这是我的VBA代码：

Option Explicit

Sub Create_Art_Doc()
    Dim wApp As Word.Application
    Dim wDoc As Word.Document
    Dim folder As FileDialog
    Dim path As String
    Dim sht As String
    Dim r As Long
    
    r = InputBox("Enter sequence number")
    r = r + 1
        
    Set folder = Application.FileDialog(msoFileDialogFolderPicker)
    folder.AllowMultiSelect = False
    
    If folder.Show = -1 Then
        path = folder.SelectedItems(1)
    End If
    
    If path = "" Then Exit Sub
    If Right(path, 1) <> "\" Then path = path & "\Art + Doc"

    Set wApp = CreateObject("Word.Application")
    wApp.Visible = True
    sht = "Details - Year B - 2023-2024"
    
    Set wDoc = wApp.Documents.Open(Filename:="G:\ArtDoc Master.dotx", ReadOnly:=True)
    
    With wDoc.Application
        .Selection.Find.Text = "[Art_Source]"
        .Selection.Find.Execute
        .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("S"))
        .Selection.EndOf
    
        .Selection.Find.Text = "[Day]"
        .Selection.Find.Execute
        .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("B"))
        .Selection.EndOf
    
        .Selection.Find.Text = "[Scripture]"
        .Selection.Find.Execute
        .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("G"))
        .Selection.EndOf
    
        .Selection.Find.Text = "[Title]"
        .Selection.Find.Execute
        .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("H"))
        .Selection.EndOf
    
        .Selection.Find.Text = "[Created]"
        .Selection.Find.Execute
        .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("I"))
        .Selection.EndOf
    
        .Selection.Find.Text = "[Medium]"
        .Selection.Find.Execute
        .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("J"))
        .Selection.EndOf
    
        .Selection.Find.Text = "[Size]"
        .Selection.Find.Execute
        .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("K"))
        .Selection.EndOf
    
        .Selection.Find.Text = "[Creator]"
        .Selection.Find.Execute
        .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("L"))
        .Selection.EndOf
    
        .Selection.Find.Text = "[Country]"
        .Selection.Find.Execute
        .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("N"))
        .Selection.EndOf
    
        .Selection.Find.Text = "[Life]"
        .Selection.Find.Execute
        .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("M"))
        .Selection.EndOf
    
        .Selection.Find.Text = "[Location]"
        .Selection.Find.Execute
        .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("P"))
        .Selection.EndOf
    
        .Selection.Find.Text = "[City]"
        .Selection.Find.Execute
        .Selection = Worksheets(sht).Cells(r, ColAlphaToNum("Q"))
        .Selection.EndOf
    End With
    
    wDoc.SaveAs2 Filename:=path, FileFormat:=wdFormatXMLDocument
    
    ' Close the Word document and the Word application
    wDoc.Close
    wApp.Quit
    ' Clean up
    Set wDoc = Nothing
    Set wApp = Nothing
        
    MsgBox "Art + Doc written to: " & path
End Sub

Function ColAlphaToNum(c As String)
    ColAlphaToNum = InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", c)
End Function

这是我的输出：

https://stregischurch.com/confirmation[Art Source]
Third Sunday of Advent
Isaiah 61:1-4, 8-11
The Dove of the Holy Spirit, 1666 
[Creator], [Country], [Life]
Stained glass, naGian Lorenzo BerniniItalian1598 - 1680
Throne of St. Peter, St. Peter's Basilica, The Vatican

其中的错误：

• [Art Source]在第一行的末尾
• [Creator]等在 5 号线上
• 艺术家的姓名、国籍和生活在第 6 行，应该填满第 5 行

注意：第六行的“na”是正确的