Excel VBA 到Word文档删除最后一行

Excel VBA to Word Document Delete last line

目标是替换文档的最后一行。最后一行总是以 $ 开头。我在这里使用 find 但不必,我无法通过任何其他方式运行。

我已在查找中成功使用 replace.text,但由于某些情况,如果没有大量 if 语句,我将无法使用它 运行 不同的查找。

除了转到页面末尾或扩展到 delete/replace $.

之后的整行外,我尝试一切正常

特别是 .Expand 函数在我尝试过的 10 种不同方法中都不适用。和 .EndKeys 永远不适合我。 (我已经尝试了 WordDoc.Expand WordApp.Expand WordSelection.Expand 设置 activedocument 等的所有组合)

此时代码有点乱。 For Each oRange 是唯一有问题的部分,这是我现在第 10 次尝试让它工作的迭代。

Sub OpenDoc()
    Dim strFile As String
    Dim strPN As String
    Dim WordApp As Object, WordDoc As Object
    Dim WordSelection As Object
    Const wdReplaceOne = 1
    Dim oRange As Object
    Dim RoundPrice As Integer
    Dim PriceString As String

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

For i = Selection.Rows.Count To 1 Step -1
If Cells(i, 4).Value <> "" Then
    If Cells(i, 4).Value <> "PN" Then
        'Print SD
        If IsError(Cells(i, 28).Value) = True Then
            RoundPrice = Cells(i, 12).Value
            RoundPrice = RoundPrice * 0.85
            PriceString = RoundPrice
            PriceString = Left(PriceString, Len(PriceString) - 1)
            PriceString = PriceString & "9"
            strPN = Cells(i, 4).Value
            strFile = "c:\Users\Robert\Desktop\Masterlist\B_" & strPN & ".docx"    'change to path of your file
            If Dir(strFile) <> "" Then    'First we check if document exists at all at given location
                'Word session creation
                Set WordApp = CreateObject("Word.Application")
                'word will be closed while running
                WordApp.Visible = True
                'open the .doc file
                Set WordDoc = WordApp.Documents.Open(strFile)
                'WordDoc.PrintOut
                Set WordSelection = WordApp.Selection
                
                 For Each oRange In WordDoc.StoryRanges
                        With oRange.Find
                        .Forward = False
                        .Text = "$"
                        .Execute Find
                        End With
                        With WordSelection
                        .Expand Unit:=wdLine
                        .Text = "$" & PriceString
                        End With
                Next oRange
                        
                  
                    WordDoc.SaveAs ("c:\Users\Robert\Desktop\B" & "_" & strPN & ".docx")
                    WordApp.Quit

            End If
          End If

    End If
End If
Next i


End Sub

您的代码无法正常工作,因为 WordSelectionSet 语句之后没有移动。您只需使用 Range 即可完成所需的工作。您还应该检查 Find 是否确实找到了一些东西。

For Each oRange In WordDoc.StoryRanges
    With oRange
        With .Find
            .Forward = False
            .Text = "$"
        End With
        If .Find.Execute Then
            .Expand Unit:=wdParagraph
            .Text = "$" & PriceString
        End If
    End With
Next oRange

您还应该摆脱后期绑定,因为使用它您一无所获。而是设置对 Word 对象库的引用并正确声明对象。这样您也将受益于 Intellisense。