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

Question

你好 Whosebug 社区。

到目前为止，我所做的是从我之前打开的 word 文档中手动复制价格，然后将其粘贴到 Excel sheet 中。它是当时在电脑上打开的唯一.docx文件，所以我们只需要在当前打开的word文件中找到价格即可。我希望你能帮我自动化这个任务。

这张图片显示了我从中复制价格的文件部分。在这个例子中它是 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 sheet 将每天更改多次）。但目标单元格将始终是 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

这就是错误 returns。

Answer 1

您可以使用我在

中使用的相同方法

创建一个范围，将其设置为等于整个文档，沿着范围搜索，移动到您想要的停止范围，然后将范围的起点向上移动到您的数字。

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

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

VBA to find specific text in word doc and copy this text from word doc into a cell in excel

excel

vba

copy

ms-word

paste