1 Тема от Mari_

  • Mari_
  • рядовой
  • Неактивен
  • Зарегистрирован: 07.05.2014
  • Сообщений: 6

Тема: Макрос для поиска даты

Добрый день! Подскажите, пожалуйста, хочу сделать макрос: по тексту документа будет искать даты, если стоит год 2014, то дату пропускало, если стоит другая дата, то дату выделяло и делало примечание с текстом «Проверьте дату». Сделала макрос на поиск даты:

Sub поиск_даты()
' поиск даты

Dim k, m As String
k = "2014"

With ActiveDocument.Range(0, 0)

Selection.HomeKey Unit:=wdStory

With Selection.Find
        .Text = k
        .MatchWildcards = True
Selection.Find.Execute

Do While Selection.Find.Found
Selection.Find.Execute

Loop

End With

End Sub

Максрос находит все даты по тексту «2014», но проблема возникает с условием, со-здать примечание (пока только поставить абзац написано в коде) на любой другой дате, делаю условие в макросе:

Sub поиск_даты()
' поиск даты

Dim k, m As String
k = "2014"

With ActiveDocument.Range(0, 0)

Selection.HomeKey Unit:=wdStory

With Selection.Find
        .Text = k
        .MatchWildcards = True
Selection.Find.Execute

Do While Selection.Find.Found

If k = "2015" Then

Selection.TypeParagraph

End If


Selection.Find.Execute

Loop

End With


End Sub

2 Ответ от Alex_Gur

  • Макрос для поиска даты
  • Alex_Gur
  • Модератор
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 28.07.2011
  • Сообщений: 2,758
  • Поблагодарили: 492

Re: Макрос для поиска даты

Mari_ пишет:

Добрый день! Подскажите, пожалуйста, хочу сделать макрос: по тексту документа будет искать даты, если стоит год 2014, то дату пропускало, если стоит другая дата, то дату выделяло и делало примечание с текстом «Проверьте дату». Сделала макрос на поиск даты:

Sub поиск_даты()
' поиск даты

Dim k, m As String
k = "2014"

With ActiveDocument.Range(0, 0)

Selection.HomeKey Unit:=wdStory

With Selection.Find
        .Text = k
        .MatchWildcards = True
Selection.Find.Execute

Do While Selection.Find.Found
Selection.Find.Execute

Loop

End With

End Sub

Здесь, по крайней мене, кажется, не хватает одного оператора "End With"

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

3 Ответ от Alex_Gur

  • Макрос для поиска даты
  • Alex_Gur
  • Модератор
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 28.07.2011
  • Сообщений: 2,758
  • Поблагодарили: 492

Re: Макрос для поиска даты

Sub Поиск2015()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "2015"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute
    
    Selection.Comments.Add Range:=Selection.Range
    Selection.TypeText Text:="Дата - не 2014"
End Sub

Данный макрос добавляет примечание к строке "2015". Обратите внимание, что, если примечание уже есть, то новое примечание Word добавить не сможет. Нужно будет предварительно удалить предыдущее примечание.

Sub УдалитьСледующееПримечание()
    Selection.Comments(1).Delete
End Sub

Для того, чтобы узнать, есть ли примечание, используйте, например, материал этой страницы:
внешняя ссылка

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

4 Ответ от Alex_Gur

  • Макрос для поиска даты
  • Alex_Gur
  • Модератор
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 28.07.2011
  • Сообщений: 2,758
  • Поблагодарили: 492

Re: Макрос для поиска даты

Проверка на наличие примечания может производиться как-то так:

Sub ЕстьЛиПримечание()
      On Error GoTo NotDefined
    If Not Selection.Comments(1) Is Nothing Then
        Selection.Comments(1).Delete
    End If

' Обработчик ошибок
NotDefined:

End Sub
Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.