VBA在word doc中查找特定文本，并将此文本从word doc复制到excel中的单元格中

Question

Hello stackoverflow社区。

[到目前为止，我一直在从以前打开的Word文档中手动复​​制价格，然后将其粘贴到Excel工作表中。这是当时在计算机上打开的唯一.docx文件，因此我们只需要在当前打开的word文件中查找价格。我希望U可以帮助我自动执行此任务。

此图片显示了我从中复制价格的那部分文档。在此示例中为605.000。但是我不知道价格，然后在Word文件中检查价格。Word文件是我了解价格的地方。所选文本在整个文档中仅出现一次，因此我需要VBA复制“ brutto w kwocie”之后的内容，直到第一个昏迷为止。是的-金额不包含小数，因为它们始终为00。但不仅有七个标志，因为如果我的公寓价格为1.250.000，那么仅复制7个标志的宏将不起作用。

Sub Find_Price()
    'Variables declaration
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    Dim TextToFind As String
    Dim ApartmentPrice As String
    Dim Rng As Word.Range
    Application.ScreenUpdating = False
    'This is the text I'm looking for in .ActiveDocument
    TextToFind = "brutto w kwocie "
    'Start Word and create an object
    'Set WordApp = CreateObject("Word.Application")
    'Reference already opened Word document from excel VBA console
    Set WordApp = GetObject(, "Word.Application")
    WordApp.Application.Visible = True
    Set Rng = WordApp.ActiveDocument.Content
    'Set WordDoc = WordApp.ActiveDocument   'I don't know how to finish this line

        Rng.Find.Execute FindText:=TextToFind, Forward:=True     
                'what this "Forward:=True" means??
        If Rng.Find.Found Then
            If Rng.Information(wdWithInTable) Then
              'I don't know how to write this part of the code.
              'Please don't remove my question again - I've researched 16h for this info.
              MsgBox "Price is " & ApartmentPrice & " pln."
            End If
        Else
            MsgBox "Apartment price was not found!"
        End If
    Set ws = ActiveSheet       'currently opened sheet on currently opened.xlsm file
    ws.Range("E27").Activate
    ws.Paste
End Sub

然后我需要从金额中间的这个荒谬点中删除数字，所以请帮助我将605.000清除为60500或1.250.000清除为1250000。

[当我在剪贴板中有此编号（价格）时，我需要将其粘贴到当前打开的excel文件中，并粘贴到.activesheet中（因为excel文件和excel工作表的名称每天都会更改多次）。但是目标单元格始终为E27-它永远不会更改。

谢谢大家的帮助。

---

编辑24.01.2020这是上述代码，我已尽力修正了。

Sub Find_Corrected()
    'Variables declaration
    'Dim WordApp As Object
    Dim WordApp As Word.Application
    'Dim WordDoc As Object
    Dim WordDoc As Word.Document
    Dim TextToFind As String
    Dim ApartmentPrice As String
    Dim Rng As Word.Range
    Application.ScreenUpdating = False
        'This is the text I'm looking for in .ActiveDocument
        TextToFind = "brutto w kwocie "
        'Start Word and create an object
        'Set WordApp = CreateObject("Word.Application")
        'Reference already opened Word document from excel VBA console
        Set WordApp = GetObject(, "Word.Application")
        Set WordDoc = WordApp.ActiveDocument
        Set Rng = WordApp.ActiveDocument.Content
        WordApp.Application.Visible = True
        'Set WordDoc = WordApp.Documents.Open(FilePath & "Form1.docx")
        'Set WordDoc = WordApp.ActiveDocument     'I don't know how to finish this line  :-(
            Rng.Find.Execute FindText:=TextToFind, Forward:=True
                    'what this "Forward:=True" means??
            With Rng.Find
                .Text = "brutto w kwocie "
                .Execute
                    If .Found = True Then
                        Rng.MoveEnd wdWord, 3
                        Rng.Copy
                        MsgBox "Copied value equals " & Rng.Value & " Roesler conquers."
                    Else
                        MsgBox "Requested range was not found!"
                    End If
            End With
    'Set ws = ActiveSheet       ' currently opened sheet on currently opened.xlsm file
    'ws.Range("E27").Activate
    'ws.Paste
End Sub

这是它返回的错误。

Answer 1

您可以使用与an answer to another of your questions.中相同的方法

创建一个范围，将其设置为等于整个文档，沿该范围搜索，移动到所需的终止范围，然后将范围的起始位置移至您的数字。

Dim srchRng as Range
Set srchRng = ActiveDocument.Content

With srchRng.Find
    .Text = "brutto w kwocie "
    .Execute
    If .Found = True Then
        Dim numberStart as Long
        numberStart = Len(srchRng.Text) + 1
        srchRng.MoveEndUntil Cset:=","

        Dim myNum as String
        myNum = Mid(srchRng.Text, numberStart)
    End If
End With