VBA для поиска указанного c текста в слове do c и копирования этого текста из слова do c в ячейку в Excel

Question

Привет сообщество stackoverflow.

То, что я делаю до сих пор, это то, что я вручную копирую цену из документа Word, который я ранее открыл, и вставляю его в лист Excel. Это единственный файл .docx, открытый в то время на компьютере, поэтому нам просто нужно найти цену в открывшемся в настоящее время файле слов. Я хотел бы, чтобы U помог мне автоматизировать эту задачу.

На этом рисунке показана часть документа, из которой я копирую цену. В этом примере это 605.000. Но я не знаю цену, пока не проверил ее в файле слов. Слово файл - это место, где я узнаю цену. Выбранный текст встречается только один раз во всем документе, поэтому мне нужно VBA, чтобы скопировать то, что после "brutto w kwo cie" и до первой комы. Да - только сумма денег без десятичных значений, потому что они всегда 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

Вы можете использовать тот же метод, который я использовал в ответе на другой ваш вопрос.

Создайте диапазон, установите его равным всему документу, выполните поиск по диапазону, двигаться до желаемого диапазона останова, затем переместить начало диапазона до ваших чисел.

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