Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Поиск подстроки вв вордде из экселя - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Поиск подстроки вв вордде из экселя (поиск определенного текста в файле docx из экселя)
Поиск подстроки вв вордде из экселя
Udik Дата: Воскресенье, 21.08.2016, 14:56 | Сообщение № 1
Группа: Друзья
Ранг: Старожил
Сообщений: 1219
Репутация: 153 ±
Замечаний: 0% ±

Excel 2013
Чет не получается у меня поиск подстрок. По идее должно выделять найденные подстроки, но не выходит.
Вообще нужно найденное выделить цветом и подсчитать количество вхождений. У меня пока даже не ищет.
[vba]
Код

Option Explicit

Public Sub findStr()
Dim objWrdApp As Object
Dim str1 As String
Dim objWrdDoc As Object
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile Application.Path & Application.PathSeparator & "MSWORD.OLB"
Set objWrdApp = GetObject(, "Word.Application")
If objWrdApp Is Nothing Then

Set objWrdApp = CreateObject("Word.Application")
Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path & "\2.docx")
Else
Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path & "\2.docx")
End If
str1 = Cells(2, 1).Value
objWrdApp.Visible = True
objWrdApp.Activate
objWrdApp.Selection.Find.ClearFormatting
objWrdApp.Selection.Find.Replacement.ClearFormatting
With objWrdApp.Selection.Find
.Text = str1 ' Ищет в Ворде текст,который нужно.
End With

Set objWrdDoc = Nothing
Set objWrdApp = Nothing
End Sub

[/vba]
К сообщению приложен файл: 7391589.xlsm(16Kb) · 0116868.docx(11Kb)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеЧет не получается у меня поиск подстрок. По идее должно выделять найденные подстроки, но не выходит.
Вообще нужно найденное выделить цветом и подсчитать количество вхождений. У меня пока даже не ищет.
[vba]
Код

Option Explicit

Public Sub findStr()
Dim objWrdApp As Object
Dim str1 As String
Dim objWrdDoc As Object
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile Application.Path & Application.PathSeparator & "MSWORD.OLB"
Set objWrdApp = GetObject(, "Word.Application")
If objWrdApp Is Nothing Then

Set objWrdApp = CreateObject("Word.Application")
Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path & "\2.docx")
Else
Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path & "\2.docx")
End If
str1 = Cells(2, 1).Value
objWrdApp.Visible = True
objWrdApp.Activate
objWrdApp.Selection.Find.ClearFormatting
objWrdApp.Selection.Find.Replacement.ClearFormatting
With objWrdApp.Selection.Find
.Text = str1 ' Ищет в Ворде текст,который нужно.
End With

Set objWrdDoc = Nothing
Set objWrdApp = Nothing
End Sub

[/vba]

Автор - Udik
Дата добавления - 21.08.2016 в 14:56
krosav4ig Дата: Воскресенье, 21.08.2016, 16:39 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1362
Репутация: 548 ±
Замечаний: 0% ±

Excel 2007, 2013
А хде .execute?


(_)Õvõ(_)

Сообщение отредактировал krosav4ig - Воскресенье, 21.08.2016, 16:43
 
Ответить
СообщениеА хде .execute?

Автор - krosav4ig
Дата добавления - 21.08.2016 в 16:39
Udik Дата: Понедельник, 22.08.2016, 13:26 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1219
Репутация: 153 ±
Замечаний: 0% ±

Excel 2013
Спасибо, с .execute разобрался, осталось понять как красить найденный текст и подсчитать количество вхождений. :) .


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеСпасибо, с .execute разобрался, осталось понять как красить найденный текст и подсчитать количество вхождений. :) .

Автор - Udik
Дата добавления - 22.08.2016 в 13:26
Manyasha Дата: Понедельник, 22.08.2016, 14:00 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 1589
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
Udik, вот так получилось:
[vba]
Код
With objWrdApp.Selection.Find
    .Text = "test" ' Ищет в Ворде текст,который нужно.
    Do
        res = .Execute
        If res Then
            'Заливка
            objWrdApp.Selection.Shading.BackgroundPatternColor = wdColorYellow
            'Выделение
            'objWrdApp.Selection.Range.HighlightColorIndex = wdRed
            cnt = cnt + 1
        End If
    Loop While res
End With
Debug.Print cnt
[/vba]


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеUdik, вот так получилось:
[vba]
Код
With objWrdApp.Selection.Find
    .Text = "test" ' Ищет в Ворде текст,который нужно.
    Do
        res = .Execute
        If res Then
            'Заливка
            objWrdApp.Selection.Shading.BackgroundPatternColor = wdColorYellow
            'Выделение
            'objWrdApp.Selection.Range.HighlightColorIndex = wdRed
            cnt = cnt + 1
        End If
    Loop While res
End With
Debug.Print cnt
[/vba]

Автор - Manyasha
Дата добавления - 22.08.2016 в 14:00
Udik Дата: Понедельник, 22.08.2016, 15:08 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 1219
Репутация: 153 ±
Замечаний: 0% ±

Excel 2013
Ага, спасибо, а то у меня излишне длинно получилось
[vba]
Код

Option Explicit

Public Sub findStr()
Dim objWrdApp As Object
Dim str1 As String
Dim objWrdDoc As Object
Dim i As Long, r As Word.Range

On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile Application.Path & Application.PathSeparator & "MSWORD.OLB"
Set objWrdApp = GetObject(, "Word.Application")
If objWrdApp Is Nothing Then Set objWrdApp = CreateObject("Word.Application")
Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path & "\2.docx")

str1 = Cells(2, 1).Value
objWrdApp.Visible = True
objWrdApp.Activate
' number text
Set r = objWrdApp.Selection.Range
  With r.Duplicate.Find
    .ClearFormatting
    Do While .Execute(str1, False, False, Wrap:=wdFindStop)
      i = i + 1 'количество вхождений
    Loop
  End With
  ' end number text
' выделение цветом
objWrdApp.Selection.Find.ClearFormatting
objWrdApp.Selection.Find.Replacement.ClearFormatting
Options.DefaultHighlightColorIndex = wdRed ' цвет выделения
With objWrdApp.Selection.Find
    .Text = str1 ' Ищет в Ворде текст,который нужно.
    .Replacement.Text = str1    ' текст для замены
    .Replacement.Highlight = True
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
objWrdApp.Selection.Find.Execute Replace:=wdReplaceAll

Set objWrdDoc = Nothing
Set objWrdApp = Nothing
End Sub

[/vba]


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеАга, спасибо, а то у меня излишне длинно получилось
[vba]
Код

Option Explicit

Public Sub findStr()
Dim objWrdApp As Object
Dim str1 As String
Dim objWrdDoc As Object
Dim i As Long, r As Word.Range

On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile Application.Path & Application.PathSeparator & "MSWORD.OLB"
Set objWrdApp = GetObject(, "Word.Application")
If objWrdApp Is Nothing Then Set objWrdApp = CreateObject("Word.Application")
Set objWrdDoc = objWrdApp.Documents.Open(ThisWorkbook.Path & "\2.docx")

str1 = Cells(2, 1).Value
objWrdApp.Visible = True
objWrdApp.Activate
' number text
Set r = objWrdApp.Selection.Range
  With r.Duplicate.Find
    .ClearFormatting
    Do While .Execute(str1, False, False, Wrap:=wdFindStop)
      i = i + 1 'количество вхождений
    Loop
  End With
  ' end number text
' выделение цветом
objWrdApp.Selection.Find.ClearFormatting
objWrdApp.Selection.Find.Replacement.ClearFormatting
Options.DefaultHighlightColorIndex = wdRed ' цвет выделения
With objWrdApp.Selection.Find
    .Text = str1 ' Ищет в Ворде текст,который нужно.
    .Replacement.Text = str1    ' текст для замены
    .Replacement.Highlight = True
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
objWrdApp.Selection.Find.Execute Replace:=wdReplaceAll

Set objWrdDoc = Nothing
Set objWrdApp = Nothing
End Sub

[/vba]

Автор - Udik
Дата добавления - 22.08.2016 в 15:08
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Поиск подстроки вв вордде из экселя (поиск определенного текста в файле docx из экселя)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!