Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
VBA Exel: найти текст в файле Word и вставить в Exel
 
Доброго времени, форумчане.
Помогите с макросом. Запускается из Exel.
Есть файл Ворд. Есть текст, который всегда находится между словами "Приложения:" и "Представитель".
Необходимо скопировать данный текст в ThisWorkbook.
Написал часть кода. Не могу найти инфу, как определить данный кусок текста.
Код
Sub Find_Copy_Paste()

Dim myWord As Object, myDoc As Object, myText As Object
Dim lastRow As Long
Dim Name As String
Dim strText1 As String, strText2 As String

Dim strN As String, strK As String 'переменные начала и конца копируемого текста

Name = ThisWorkbook.Worksheets("ID+cert").Range("B2") & ".docx"
strText1 = "Приложения:" '+1 - Начало фрагмента текста
strText2 = "Представитель" '-1 - Конец фрагмента текста

    Set myWord = GetObject(, "Word.Application")
    Set myDoc = myWord.Documents(Name)
    Set myText = myDoc.Range




ThisWorkbook.Worksheets("Листы").Range("A3") = скопированный текст

End Sub
Возможно кто-то сталкивался с подобным?
На форуме находил похожие темы, но там описывают работу из-под файла ворд.
 
Изменено: Анатолий - 20.03.2024 15:45:23
определение коэффициентов по нескольким условиям, Несколько раз ЕСЛИ бывает?
 
Добрый день.
=ЕСЛИМН()
Изменено: Анатолий - 12.03.2024 10:35:39
Как обращаться к ячейкам разных листов из пользовательской формы?
 
Цитата
написал:
В присвоении для Rng не указано, к какому листу относится Columns(1) (возможно, нужно добавить в начале точку)Благодарю
Благодарю за подсказку.
Проблема решена.
Добавил строчку с Sheets().Select перед Rng.
Всем спасибо.
Как обращаться к ячейкам разных листов из пользовательской формы?
 
Цитата
написал:
Понятно, что на форуме по Excel, глупо задавать вопрос по кройке/шитью. Ознакомьтесь с Правилами и предложите название для Темы. Помощи скрыта
Добрый день. Подскажите как изменить тему. Я не смог найти решение (
Как обращаться к ячейкам разных листов из пользовательской формы?
 
Цитата
написал:
Можно вообще не указывать, тогда будет работать как Вам
Я правильно понимаю, ThisWorkbook.Worksheets заменить на Sheets?
Если так, то не помогло.
Как обращаться к ячейкам разных листов из пользовательской формы?
 
Добрый день.
Подскажите пожалуйста, где собака зарыта? Есть книга с несколькими листами.
Создал форму и написал макрос. Все работает, но правильные данные макрос вытягивает, только если находишься на листе который указал в форме.
А хочется что бы правильные данные вытягивались при нахождении в любом месте книги.
Копирование данных из Ворда в Эксель макросом
 
МатросНаЗебре, Ваш вариант сработал.

Парни, всем огромное спасибо. Моя проблема решена.
Копирование данных из Ворда в Эксель макросом
 
andypetr, огромное спасибо.
Ваш код работает.
Разрешите еще один совет:
код заполняет вот такую таблицу (первые 6 колонок).



Как можно заполнить столбец G (Номер акта) значениями из переменной NumAct  (колонку на скрине я заполнил в ручную)?
Я уже вам благодарен за подсказку, но если Вас не затруднит, посмотрите код еще раз пожалуйста.
Изменено: Анатолий - 23.01.2024 13:25:32
Копирование данных из Ворда в Эксель макросом
 
Добрый день, форумчане.
Возникла ошибка 429 в коде.
Смысл кода - найти файл ворд на сервере (все пути на отдельном листе Акты) и скопировать данные из таблиц в эксель.
Без цикла For Line... код работает идеально, но требуется обработать более 3000 строк. И вот я решил попробовать цикл.
Желтым горит строчка
Set objWrdApp = GetObject(, "Word.Application").
Возможно подскажите в чем кроется проблема. Я сам начинающий пользователь VBA, поэтому прошу не ругаться если код не идеальный )
Сам код ниже.
Код
Sub Copy_Paste_Full()

Dim lastRow As Long
Dim Line As Long
Dim NumAct As String, Path As String
Dim objWrdApp As Object
Dim objWrdDoc As Object
Dim lCol As Long, aTbl As Long, i As Long, j As Long, lastRow_1 As Long

lastRow = ThisWorkbook.Worksheets("Акты").Range("A" & Rows.Count).End(xlUp).Row

For Line = 2 To lastRow

NumAct = ThisWorkbook.Worksheets("Акты").Range("A" & Line)
Path = ThisWorkbook.Worksheets("Акты").Range("B" & Line)

'    On Error Resume Next
    Set objWrdApp = GetObject(, "Word.Application")
    If objWrdApp Is Nothing Then
        Set objWrdApp = CreateObject("Word.Application")
        Set objWrdDoc = objWrdApp.Documents.Open(Path)
            objWrdDoc.Activate
            objWrdApp.Visible = True
    End If

    lCol = objWrdDoc.tables.Count

    For aTbl = 2 To lCol - 1
        ReDim arr(1 To objWrdDoc.tables(aTbl).Rows.Count, 1 To objWrdDoc.tables(aTbl).Columns.Count)
            For j = 1 To UBound(arr, 2)
                For i = 2 To UBound(arr, 1)
                    arr(i, j) = Trim(Replace(objWrdDoc.tables(aTbl).cell(i, j).Range.Text, Chr(7), ""))
                Next i
            Next j
        
            lastRow_1 = ThisWorkbook.Worksheets("ID").Range("A" & Rows.Count).End(xlUp).Row
        
            ThisWorkbook.Sheets("ID").Range("A" & lastRow_1 + 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr

        If Range("A" & lastRow_1 + 1) = "" Then
            Range("A" & lastRow_1 + 1).EntireRow.Delete
        End If

    Next aTbl

        GetObject(, "Word.Application").Quit

Next Line

End Sub
Разбить на разные строки значение, внесённое в одну ячейку., Разделить ячейку
 
Подход в PQ называется "Разделить столбец" в 19 офисе.

Огромное спасибо!!!

Я неделю уже разбиваю строки, а тут 3 строчки кода.

Когда знаешь - все просто.
Разбить на разные строки значение, внесённое в одну ячейку., Разделить ячейку
 
Уважаемые, подскажите пожалуйста, а можно ли разбить сразу несколько столбцов на строки (по разделителю "перенос") каким-либо способом, т.к. стандартным подходом PQ не позволяет. Количество разделений в ячейках совпадает. В файле пример (возможно самый грубый). Возможно макрос есть какой.
Изменено: Анатолий - 15.12.2023 16:57:46
поиск и открытие файла эксель по названию из ячейки
 
Я еще тот кодер - посмотрел и ...
В общем, все печально для меня. Я только начинаю познавать дзен VBA. Я весь код собирал по крохам из инета )
Возможно подскажите, где можно подсмотреть подобный код?
поиск и открытие файла эксель по названию из ячейки
 
Ошибка 429

ActivX component can't creative object - компонент ActivX не может создать объект.

Строчка

Set objWrdApp = GetObject(, "Word.Application")

загорелась желтым при отладке.
поиск и открытие файла эксель по названию из ячейки
 
Доброго дня форумчане.
Прошу помощи у знающих.
Есть код:
он открывает файл ворд по указанному адресу и выкопирует таблицы
Код
Sub Copy_Paste()

Dim objWrdApp As Object
Dim objWrdDoc As Object
Dim NameFile As String, NameFolder As String
Dim lCol As Long, aTbl As Long, i As Long, j As Long, lastRow3 As Long

NameFolder = Range("B1").Value & "\"
NameFile = NameFolder & Range("B2") & ".docx"

    On Error Resume Next
    Set objWrdApp = GetObject(, "Word.Application")
    If objWrdApp Is Nothing Then
        Set objWrdApp = CreateObject("Word.Application")
        Set objWrdDoc = objWrdApp.Documents.Open("\\x-srv63-x\xxxx\xxxx\xxxx\1\xxxx\" & NameFile)
            objWrdDoc.Activate
            objWrdApp.Visible = True
    End If

'lCol = objWrdDoc.tables.Count
'
'For aTbl = 2 To lCol - 1
'    ReDim arr(1 To objWrdDoc.tables(aTbl).Rows.Count, 1 To objWrdDoc.tables(aTbl).Columns.Count)
'        For j = 1 To UBound(arr, 2)
'            For i = 2 To UBound(arr, 1)
'                arr(i, j) = Trim(Replace(objWrdDoc.tables(aTbl).cell(i, j).Range.Text, Chr(7), ""))
'            Next i
'        Next j
'
'    With Sheets("ID")
'        lastRow3 = ThisWorkbook.Worksheets("ID").Range("A" & Rows.Count).End(xlUp).Row
'    End With
'
'        ThisWorkbook.Sheets("ID").Range("A" & lastRow3 + 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
'
'    If Range("A" & lastRow3 + 1) = "" Then
'        Range("A" & lastRow3 + 1).EntireRow.Delete
'    End If
'
'Next

End Sub

Проблема вот с этой строкой

Set objWrdDoc = objWrdApp.Documents.Open("\\xxx-srv63-xx\xxxx\xxxx\xxxx\1\xxxx\" & NameFile)

При открытии с рабочего стола/диска С: файл код работает.
Но если путь указывает на сервер (как в приложении) - открывается пустой файл ворд.
Подскажите, пжл,  в чем может быть проблема?
Заранее благодарю за помощь.
Сумма за период по условию
 
Благодарю, добрый человек. Все работает.
Сумма за период по условию
 
Доброго времени.
Прошу дать подсказку какие функции необходимо использовать для выполнения задачи. Условие в приложенном файле.
Через ИНДЕКС ПОИСКПОЗ могу найти значение ячейки. Но как суммировать я голову сломал.
Страницы: 1
Наверх