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

Вход

Регистрация

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

 

= Мир MS Excel/Определить разрыв страницы в Word - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, китин  
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Определить разрыв страницы в Word
Определить разрыв страницы в Word
devilkurs Дата: Пятница, 13.11.2015, 12:13 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 167
Репутация: 43 ±
Замечаний: 0% ±

Excel 2007, 2010
День добрый форумчане.
СПАСАЙТЕ плииз.
Возможно ли в выделенной строке Word определить наличие разрыва страницы (^m) ???

Через поиск по спецсимволу ^m придумать ничего не могу
(макрос пишется на коленях с большой скоростью, поэтому не критикуйте пожалуйста сильно)
Задача:
при сборе информации в массив производится перебор всех строк. Возможно ли на этой стадии определить имеется ли разрыв страницы?
В примере необходимо удалить ПЕРВЫЙ разрыв страницы и одну пустую строку следом за ним. Разрыв страницы в конце документа трогать нельзя.
В реальности таких разрывов внутри документов может попадаться много.

Или еще вариант: выделить документ по закладкам и внутри выделения убрать разрыв страницы и одну пустую строку следом за ним???

[vba]
Код

Sub Rasporyajka()
'ВЫДЕРЖКА из макроса
Dim ДанныеРаспоряжки() As String
СчетРаспоряжек = 1

Selection.HomeKey Unit:=wdStory 'на первый лист встать
ReDim ДанныеРаспоряжки(1 To СчетРаспоряжек, 1 To 4, 1 To 10) 'номер распоряжки, данные, кол-во операций

НаВсякийСлучай = 0
For i = 1 To СчетРаспоряжек
    СчетОперации = 0
    Selection.Find.ClearFormatting 'поиск
    Selection.Find.Text = "Отметка Отдела сопровождения об исполнении распоряжения"

    Selection.Find.Execute

        Do 'шагаем вверх до начала распоряжки
    Selection.HomeKey Unit:=wdLine
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        
        Loop Until InStr(Replace(Selection.Text, Chr(13), ""), "Какая то шарага в каком то городе") > 0
    With Selection
        .HomeKey Unit:=wdLine
        .TypeParagraph
        .TypeParagraph 'новая строка, как клавишей Энтер
        .MoveUp Unit:=wdLine, Count:=1
        .MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        .Bookmarks.Add Range:=Selection.Range, Name:="НачалоРаспоряжки" & i 'ставим закладку
    End With
        Do 'шагаем вниз до конца распоряжки
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
            'соберем в массив данные с распоряжки (дебет, кредет, суммма)
        If Mid(Selection.Text, 2, 7) = "Дебет :" Then
            СчетОперации = СчетОперации + 1
            If СчетОперации > НаВсякийСлучай + 10 Then
                    НаВсякийСлучай = СчетОперации + 9
                    ReDim Preserve ДанныеРаспоряжки(1 To СчетРаспоряжек, 1 To 4, 1 To НаВсякийСлучай)
            End If
            ДанныеРаспоряжки(i, 1, СчетОперации) = Mid(Selection.Text, 10, 20)
        End If
        If Mid(Selection.Text, 2, 7) = "Кредит:" Then
            ДанныеРаспоряжки(i, 2, СчетОперации) = Mid(Selection.Text, 10, 20)
        End If
        If Mid(Selection.Text, 2, 7) = "Сумма :" Then
            aaaa = Replace(Replace(Replace(Trim(Mid(Selection.Text, 9)), " ", ""), "-", "."), ",", "")
            ДанныеРаспоряжки(i, 3, СчетОперации) = Mid(aaaa, 1, Len(aaaa) - 1)
        End If
        If СчетОперации = 1 Then ДанныеРаспоряжки(i, 4, СчетОперации) = True

        
        Loop Until Replace(Selection.Text, Chr(13), "") = ChrW(9474) & "                 Дата               " & ChrW(9474) & "                 Подпись ответственного сотрудника                 " & ChrW(9474)
    
    With Selection
        .HomeKey Unit:=wdLine
        .MoveDown Unit:=wdLine, Count:=4 'на 4 вниз
        .TypeParagraph 'новая строка, как клавишей Энтер
        .InsertBreak Type:=wdPageBreak 'вставляем разрыв страницы
        .MoveUp Unit:=wdLine, Count:=1 'на 1 строку вверх
        .EndKey Unit:=wdLine 'на конец строки
        .MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend 'выделим один символ для установки закладки
        .Bookmarks.Add Range:=Selection.Range, Name:="КонецРаспоряжки" & i 'ставим закладку
    
        .MoveDown Unit:=wdLine, Count:=1 'на 1 строк вниз
    End With

Next i

End Sub
[/vba]
К сообщению приложен файл: 6508562.doc (52.0 Kb)



Сообщение отредактировал devilkurs - Пятница, 13.11.2015, 12:24
 
Ответить
СообщениеДень добрый форумчане.
СПАСАЙТЕ плииз.
Возможно ли в выделенной строке Word определить наличие разрыва страницы (^m) ???

Через поиск по спецсимволу ^m придумать ничего не могу
(макрос пишется на коленях с большой скоростью, поэтому не критикуйте пожалуйста сильно)
Задача:
при сборе информации в массив производится перебор всех строк. Возможно ли на этой стадии определить имеется ли разрыв страницы?
В примере необходимо удалить ПЕРВЫЙ разрыв страницы и одну пустую строку следом за ним. Разрыв страницы в конце документа трогать нельзя.
В реальности таких разрывов внутри документов может попадаться много.

Или еще вариант: выделить документ по закладкам и внутри выделения убрать разрыв страницы и одну пустую строку следом за ним???

[vba]
Код

Sub Rasporyajka()
'ВЫДЕРЖКА из макроса
Dim ДанныеРаспоряжки() As String
СчетРаспоряжек = 1

Selection.HomeKey Unit:=wdStory 'на первый лист встать
ReDim ДанныеРаспоряжки(1 To СчетРаспоряжек, 1 To 4, 1 To 10) 'номер распоряжки, данные, кол-во операций

НаВсякийСлучай = 0
For i = 1 To СчетРаспоряжек
    СчетОперации = 0
    Selection.Find.ClearFormatting 'поиск
    Selection.Find.Text = "Отметка Отдела сопровождения об исполнении распоряжения"

    Selection.Find.Execute

        Do 'шагаем вверх до начала распоряжки
    Selection.HomeKey Unit:=wdLine
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        
        Loop Until InStr(Replace(Selection.Text, Chr(13), ""), "Какая то шарага в каком то городе") > 0
    With Selection
        .HomeKey Unit:=wdLine
        .TypeParagraph
        .TypeParagraph 'новая строка, как клавишей Энтер
        .MoveUp Unit:=wdLine, Count:=1
        .MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        .Bookmarks.Add Range:=Selection.Range, Name:="НачалоРаспоряжки" & i 'ставим закладку
    End With
        Do 'шагаем вниз до конца распоряжки
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
            'соберем в массив данные с распоряжки (дебет, кредет, суммма)
        If Mid(Selection.Text, 2, 7) = "Дебет :" Then
            СчетОперации = СчетОперации + 1
            If СчетОперации > НаВсякийСлучай + 10 Then
                    НаВсякийСлучай = СчетОперации + 9
                    ReDim Preserve ДанныеРаспоряжки(1 To СчетРаспоряжек, 1 To 4, 1 To НаВсякийСлучай)
            End If
            ДанныеРаспоряжки(i, 1, СчетОперации) = Mid(Selection.Text, 10, 20)
        End If
        If Mid(Selection.Text, 2, 7) = "Кредит:" Then
            ДанныеРаспоряжки(i, 2, СчетОперации) = Mid(Selection.Text, 10, 20)
        End If
        If Mid(Selection.Text, 2, 7) = "Сумма :" Then
            aaaa = Replace(Replace(Replace(Trim(Mid(Selection.Text, 9)), " ", ""), "-", "."), ",", "")
            ДанныеРаспоряжки(i, 3, СчетОперации) = Mid(aaaa, 1, Len(aaaa) - 1)
        End If
        If СчетОперации = 1 Then ДанныеРаспоряжки(i, 4, СчетОперации) = True

        
        Loop Until Replace(Selection.Text, Chr(13), "") = ChrW(9474) & "                 Дата               " & ChrW(9474) & "                 Подпись ответственного сотрудника                 " & ChrW(9474)
    
    With Selection
        .HomeKey Unit:=wdLine
        .MoveDown Unit:=wdLine, Count:=4 'на 4 вниз
        .TypeParagraph 'новая строка, как клавишей Энтер
        .InsertBreak Type:=wdPageBreak 'вставляем разрыв страницы
        .MoveUp Unit:=wdLine, Count:=1 'на 1 строку вверх
        .EndKey Unit:=wdLine 'на конец строки
        .MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend 'выделим один символ для установки закладки
        .Bookmarks.Add Range:=Selection.Range, Name:="КонецРаспоряжки" & i 'ставим закладку
    
        .MoveDown Unit:=wdLine, Count:=1 'на 1 строк вниз
    End With

Next i

End Sub
[/vba]
Автор - devilkurs
Дата добавления - 13.11.2015 в 12:13
devilkurs Дата: Пятница, 13.11.2015, 12:21 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 167
Репутация: 43 ±
Замечаний: 0% ±

Excel 2007, 2010
Что-то не вижу что файл прикрепился
К сообщению приложен файл: Primer.doc (52.0 Kb)



Сообщение отредактировал devilkurs - Пятница, 13.11.2015, 12:31
 
Ответить
СообщениеЧто-то не вижу что файл прикрепился
Автор - devilkurs
Дата добавления - 13.11.2015 в 12:21
devilkurs Дата: Пятница, 13.11.2015, 12:50 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 167
Репутация: 43 ±
Замечаний: 0% ±

Excel 2007, 2010
Может как-то в таком виде???

[vba]
Код
    ActiveDocument.Range( _
    Start:=ActiveDocument.Bookmarks("НачалоРаспоряжки" & i).Range.Start, _
    End:=ActiveDocument.Bookmarks("КонецРаспоряжки" & i).Range.End).Select
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend 'уменьшаем выделения на строку вверх
    
    Selection.Find.ClearFormatting 'ищем разрыв страницы
    With Selection.Find
        .Text = "^m"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute

    Selection.Delete Unit:=wdCharacter, Count:=2
[/vba]

Это вставить перед Next i .
Но как это дело зациклить, если разрывов не один, а несколько??

 
Ответить
СообщениеМожет как-то в таком виде???

[vba]
Код
    ActiveDocument.Range( _
    Start:=ActiveDocument.Bookmarks("НачалоРаспоряжки" & i).Range.Start, _
    End:=ActiveDocument.Bookmarks("КонецРаспоряжки" & i).Range.End).Select
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend 'уменьшаем выделения на строку вверх
    
    Selection.Find.ClearFormatting 'ищем разрыв страницы
    With Selection.Find
        .Text = "^m"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute

    Selection.Delete Unit:=wdCharacter, Count:=2
[/vba]

Это вставить перед Next i .
Но как это дело зациклить, если разрывов не один, а несколько??
Автор - devilkurs
Дата добавления - 13.11.2015 в 12:50
devilkurs Дата: Понедельник, 16.11.2015, 10:02 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 167
Репутация: 43 ±
Замечаний: 0% ±

Excel 2007, 2010
И никто ничего не подсказал. :(
Все считают это элементарно? Или никто не знает? Или тупо впадлу было?

После выходных додумался сам. (пришлось задержать сроки. плохо)

К первоначальному (верхнему) коду перед Next i добавить следующее:

[vba]
Код
'________________________________________________________________________
'удаляем не нужные разрывы
    ActiveDocument.Range( _
    Start:=ActiveDocument.Bookmarks("НачалоРаспоряжки" & i).Range.Start, _
    End:=ActiveDocument.Bookmarks("КонецРаспоряжки" & i).Range.End).Select
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend 'Уменьшаем выделение на одну строку вверх чтоб не удалить разрыв в конце документа
    
  With Selection.Range.Duplicate.Find
    .ClearFormatting
   
    Do While .Execute("^m", False, False, Wrap:=wdFindStop)
         If .Parent.Start > Selection.Range.End Then Exit Do
        .Parent.Delete Unit:=wdCharacter, Count:=2 '2 раза как клавишей Delete
    Loop
  End With
'________________________________________________________________________
[/vba]



Сообщение отредактировал devilkurs - Понедельник, 16.11.2015, 10:10
 
Ответить
СообщениеИ никто ничего не подсказал. :(
Все считают это элементарно? Или никто не знает? Или тупо впадлу было?

После выходных додумался сам. (пришлось задержать сроки. плохо)

К первоначальному (верхнему) коду перед Next i добавить следующее:

[vba]
Код
'________________________________________________________________________
'удаляем не нужные разрывы
    ActiveDocument.Range( _
    Start:=ActiveDocument.Bookmarks("НачалоРаспоряжки" & i).Range.Start, _
    End:=ActiveDocument.Bookmarks("КонецРаспоряжки" & i).Range.End).Select
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend 'Уменьшаем выделение на одну строку вверх чтоб не удалить разрыв в конце документа
    
  With Selection.Range.Duplicate.Find
    .ClearFormatting
   
    Do While .Execute("^m", False, False, Wrap:=wdFindStop)
         If .Parent.Start > Selection.Range.End Then Exit Do
        .Parent.Delete Unit:=wdCharacter, Count:=2 '2 раза как клавишей Delete
    Loop
  End With
'________________________________________________________________________
[/vba]
Автор - devilkurs
Дата добавления - 16.11.2015 в 10:02
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Определить разрыв страницы в Word
  • Страница 1 из 1
  • 1
Поиск:

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