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
您的代码无法正常工作,因为 WordSelection
在 Set
语句之后没有移动。您只需使用 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。
目标是替换文档的最后一行。最后一行总是以 $ 开头。我在这里使用 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
您的代码无法正常工作,因为 WordSelection
在 Set
语句之后没有移动。您只需使用 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。