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

Question

The goal is to replace the last line of a document. The last line always starts with a $. I am using a find here but don't have to, I couldn't get any other way to function.

I have used replace.text successfully within find but due to some conditions I can't use that without tons of if statements running different Finds.

Everything seems to be working I try except for going to the end of the page or expanding to delete/replace the entire line after the $.

Specifically the.Expand function doesn't work for me the 10 different ways I've tried. and.EndKeys never works for me. (I have tried every combination of WordDoc.Expand WordApp.Expand WordSelection.Expand setting activedocument etc.)

The code is a bit of a mess at this point. The For Each oRange is the only part with issues and is my 10th iteration of trying to get it to work by now.

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

Answer 1

Your code isn't working because WordSelection doesn't get moved after the Set statement. You can accomplish what you need just using the Range. You should also check that Find actually found something.

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

You should also get rid of the late binding as you gain nothing at all by using it. Instead set a reference to the Word object library and declare the objects properly. That way you will also have the benefit of Intellisense.