Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 04.10.2017, 19:37   #1
bdfy
Форумчанин
 
Регистрация: 12.11.2009
Сообщений: 258
По умолчанию Поиск по значениям полей

В тексте есть некоторые поля (автономера). Например для формулы это будет поле {STYLEREF 1 \s}.{ SEQ Формула \* ARABIC \s 1}
значение 2.6 например
Как это значение в тексте найти (в том числе по маске) ?
Если искать в тексте просто 2.6 - поле игнорируется, если искать код поля- тоже ничего не находит.
Так как можно искать по кодам полей ?
bdfy вне форума Ответить с цитированием
Старый 06.10.2017, 04:03   #2
Ципихович Эндрю
Старожил
 
Регистрация: 24.01.2011
Сообщений: 3,034
По умолчанию

искать макросом
Ципихович Эндрю вне форума Ответить с цитированием
Старый 06.10.2017, 09:59   #3
bdfy
Форумчанин
 
Регистрация: 12.11.2009
Сообщений: 258
По умолчанию

Так я и ищу макросом по маске. И в том то и дело что макрос не находит таких полей. Как их искать правильно ?
bdfy вне форума Ответить с цитированием
Старый 07.10.2017, 08:02   #4
Ципихович Эндрю
Старожил
 
Регистрация: 24.01.2011
Сообщений: 3,034
По умолчанию

Код:
For q = 1 To ActiveDocument.Fields.Count
Код_обрабатываемого_поля = Trim$(ActiveDocument.Fields(q).Code)
Next q
Код:
  'номер первого выделенного поля
    SelectionFields1Index = Selection.Fields(1).Index
Ципихович Эндрю вне форума Ответить с цитированием
Старый 12.10.2017, 15:59   #5
bdfy
Форумчанин
 
Регистрация: 12.11.2009
Сообщений: 258
По умолчанию

Все равно далек я от решения
Есть вот такой вот код
Код:
Set p = oDoc.Application.Selection.Paragraphs(1)
Set oRng = p.Range 

'oRng.Select
'p.Range.ParagraphFormat.TabStops.ClearAll
   
                    
        For Each regexp1 In Array("[ ]{2;}", "^t", "\([0-9]{1;3}\)", "\([0-9]{1;3}.[0-9]{1;3}\)") 'Удаляем пустые пробелы/табуляции, удаляем скобки с номером
                     With oRng.Find
                     .ClearFormatting
                        .MatchWildcards = True
                        .Text = regexp1
                        .Replacement.Text = ""
                        .Forward = True
                        .Wrap = wdFindStop
                        .Execute replace:=2
                    End With
        Next regexp1
Он берет строчку с формулой (это может быть как обьект Mathtype так и просто текст, так и картинка) и удаляет лишнее. В том числе записи вида (2) или (2.1) - это номерация формул. Проблема возникает если в тексте автонумерация формул - я не понимаю как найти и удалить из строки такие элементы
bdfy вне форума Ответить с цитированием
Старый 12.10.2017, 17:16   #6
Ципихович Эндрю
Старожил
 
Регистрация: 24.01.2011
Сообщений: 3,034
По умолчанию

У Вас хоть роз есть в коде Fields? приложите файл, что за поля и что нужно сделать
Ципихович Эндрю вне форума Ответить с цитированием
Старый 12.10.2017, 20:02   #7
bdfy
Форумчанин
 
Регистрация: 12.11.2009
Сообщений: 258
По умолчанию

Вот файл пример с формулами (разные варианты)
Вот таким кодом сейчас эти формулы оформляются. Но выполнение падает если встречается уже оформленная строка, так как не удаляется автоматическая нумерация. Можно конечно Fields.Unlink принудительно сделать наверное... но не совсем это правильно - с формулах могут быть внешние ссылки (на ексель например), которые убивать бы не хотелось.
Код:
Sub оформить_формулу_табуляцией(ByVal p As Word.Paragraph) 'As Variant
Set oDoc = ActiveDocument

'Set p = oDoc.Application.Selection.Paragraphs(1)

Set oRng = p.Range '.Characters(1)

'oRng.Select
'p.Range.ParagraphFormat.TabStops.ClearAll
   
                    
        For Each regexp1 In Array("[ ]{2;}", "^t", "\([0-9]{1;3}\)", "\([0-9]{1;3}.[0-9]{1;3}\)") 'Удаляем пустые пробелы/табуляции, удаляем скобки с номером
                     With oRng.Find
                     .ClearFormatting
                        .MatchWildcards = True
                        .Text = regexp1
                        .Replacement.Text = ""
                        .Forward = True
                        .Wrap = wdFindStop
                        .Execute replace:=2
                    End With
        Next regexp1

oRng.SetRange Start:=oRng.Start, End:=oRng.End - 1

'oRng.Select
'oDoc.Application.Selection.Cut





    oRng.ParagraphFormat.TabStops.ClearAll

    oRng.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(8.25) _
        , Alignment:=wdAlignTabCenter, Leader:=wdTabLeaderSpaces
    oRng.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(16.5) _
        , Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
        

     'p.Range.InsertText Text:=vbTab & "sdfsfs" & vbTab & "(1.2)"
     With oRng
             '.Collapse
            .InsertBefore vbTab
            .InsertAfter vbTab
            '.InsertParagraphAfter
            
            .Collapse (wdCollapseEnd)
            .InsertBefore ")"

            Set oFld = .Fields.Add(oRng, , " SEQ Формула \* ARABIC \s 1", False)
           
            
            .InsertBefore "."
            
           .Collapse
            Set oFld = .Fields.Add(oRng, , "STYLEREF 1 \s", False)
            
            .InsertBefore "("

            


     End With

'Selection.Expand Unit:=wdLine
'oRng.Font.Color = wdColorRed
'Selection.InsertParagraphAfter
'Debug.Print " el.Paragraphs.Count " & sel.Paragraphs.Count
'sel.Select


End Sub
Вложения
Тип файла: doc Пояснительная записка_тест_формулы.doc (59.5 Кб, 12 просмотров)
bdfy вне форума Ответить с цитированием
Старый 14.10.2017, 16:43   #8
Ципихович Эндрю
Старожил
 
Регистрация: 24.01.2011
Сообщений: 3,034
По умолчанию

будем отталкиваться от приложенного файла, в нём 10 полей
выясняем кодом
Код:
Private Sub d()
    MsgBox ActiveDocument.Fields.Count

    For q = 1 To ActiveDocument.Fields.Count
        Код_обрабатываемого_поля = Trim$(ActiveDocument.Fields(q).Code)
        'MsgBox Код_обрабатываемого_поля
        Debug.Print Код_обрабатываемого_поля
    Next q

End Sub
EMBED Equation.3
EMBED Equation.3
EMBED Equation.DSMT4
STYLEREF 1 \s
SEQ Формула \* ARABIC \s 1
EMBED Equation.DSMT4
EQ ?U\s\do(пл) = \f(М\s\do(п);C·F\s\do(выбр)) = \f(33;48·2,5) = 0,275 %
EMBED Equation.DSMT4
STYLEREF 1 \s
SEQ Формула \* ARABIC \s 1
что нужно?
Ципихович Эндрю вне форума Ответить с цитированием
Старый 17.10.2017, 17:42   #9
bdfy
Форумчанин
 
Регистрация: 12.11.2009
Сообщений: 258
По умолчанию

Цитата:
For Each regexp1 In Array("[ ]{2;}", "^t", "\([0-9]{1;3}\)", "\([0-9]{1;3}.[0-9]{1;3}\)") 'Удаляем пустые пробелы/табуляции, удаляем скобки с номером
Вот нужен некий способ удалить в том числе и скобки с автономером
Выглядит это как
( STYLEREF 1 \s SEQ Формула \* ARABIC \s 1 )
bdfy вне форума Ответить с цитированием
Старый 21.10.2017, 19:16   #10
Борис_Р
Пользователь
 
Регистрация: 18.02.2013
Сообщений: 26
По умолчанию

Цитата:
Сообщение от bdfy Посмотреть сообщение
Вот нужен некий способ удалить в том числе и скобки с автономером
Пробуйте код
Код:
Sub fields1unlink1()
'
'
    Dim myRange As Range
    Set myRange = ActiveDocument.Content
    myRange.Fields.Update
    myRange.Fields.ToggleShowCodes
    With myRange.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "STYLEREF 1 \s"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
            Do While .Execute
               myRange.Fields.Unlink
            Loop
        End With
    With myRange.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "SEQ Формула "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
            Do While .Execute
               myRange.Fields.Unlink
            Loop
       ActiveDocument.Content.Fields.Update
     End With
Борис_Р вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Авто-поиск по двум значениям Freesty1er Microsoft Office Excel 3 08.11.2013 13:56
Отфильтровать данные по определенным значениям 2-ух разных полей Blame Microsoft Office Excel 1 26.10.2012 00:52
Параллельный поиск по 2 значениям KuroiRyuu Microsoft Office Excel 4 17.07.2012 19:36
Поиск ctrrl+f не по формулам а по значениям (сразу) ЮрийОдесса Microsoft Office Excel 7 29.01.2012 17:06
поиск данных по двум значениям robbe Microsoft Office Excel 14 13.01.2010 12:03