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

Вход

Регистрация

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

 

= Мир MS Excel/Скопировать выделенный текст в отдельный файл макросом. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, китин  
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Скопировать выделенный текст в отдельный файл макросом.
Скопировать выделенный текст в отдельный файл макросом.
Mark1976 Дата: Понедельник, 16.03.2020, 08:03 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 738
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
Здравствуйте. Возможно ли написать макрос, который бы копировал в отдельный файл текст в заливке, при каждом выполнении макроса текст в заливке должен копироваться в один и тот же файл с добавлением.
К сообщению приложен файл: __2019_.docx (14.9 Kb)
 
Ответить
СообщениеЗдравствуйте. Возможно ли написать макрос, который бы копировал в отдельный файл текст в заливке, при каждом выполнении макроса текст в заливке должен копироваться в один и тот же файл с добавлением.

Автор - Mark1976
Дата добавления - 16.03.2020 в 08:03
anvg Дата: Понедельник, 16.03.2020, 19:10 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 581
Репутация: 271 ±
Замечаний: 0% ±

2016, 365
Доброе время суток
Возможно ли написать макрос

Да, опираясь на свойство диапазона Range.HighlightColorIndex = wdYellow (в вашем случае находите диапазон слов, в котором первое слово маркировано, остальные последовательно маркированы, а последнее слово содержит после себя или конец документа или не маркированное слово. Соответственно, задаёте диапазон символов от первого символа первого слова по последний символ последнего слова и копируете в новый документ. И так пока всё не скопируете.
 
Ответить
СообщениеДоброе время суток
Возможно ли написать макрос

Да, опираясь на свойство диапазона Range.HighlightColorIndex = wdYellow (в вашем случае находите диапазон слов, в котором первое слово маркировано, остальные последовательно маркированы, а последнее слово содержит после себя или конец документа или не маркированное слово. Соответственно, задаёте диапазон символов от первого символа первого слова по последний символ последнего слова и копируете в новый документ. И так пока всё не скопируете.

Автор - anvg
Дата добавления - 16.03.2020 в 19:10
Mark1976 Дата: Вторник, 17.03.2020, 20:55 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 738
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
anvg, к сожалению я не умею писать макросы.
 
Ответить
Сообщениеanvg, к сожалению я не умею писать макросы.

Автор - Mark1976
Дата добавления - 17.03.2020 в 20:55
anvg Дата: Вторник, 17.03.2020, 22:21 | Сообщение № 4
Группа: Друзья
Ранг: Ветеран
Сообщений: 581
Репутация: 271 ±
Замечаний: 0% ±

2016, 365
я не умею писать макросы
Не понял вашего сожаления. Вы спрашивали про
Возможно ли написать макрос
Я ответил, что возможно. Каков вопрос, таков и ответ.
 
Ответить
Сообщение
я не умею писать макросы
Не понял вашего сожаления. Вы спрашивали про
Возможно ли написать макрос
Я ответил, что возможно. Каков вопрос, таков и ответ.

Автор - anvg
Дата добавления - 17.03.2020 в 22:21
bmv98rus Дата: Суббота, 21.03.2020, 10:21 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4098
Репутация: 766 ±
Замечаний: 0% ±

Excel 2013/2016
ну я б в цикле поискал Find.HitHighlight и найденное переносил. И тоже согласен с Андреем - на вопрос можно ответ или да или нет. Судя по всему вы хотите получить готовый макрос, что совершенно о другом.

[vba]
Код
Sub CopyHiglighted()
Application.ScreenUpdating = False
    
Set Sourcedoc = ThisDocument
Set Myrange = ThisDocument.Content
Set newDoc = Documents.Add(Template:="Normal", NewTemplate:=False, DocumentType:=0)
Sourcedoc.Activate
    With Myrange
        With .Find
            .ClearFormatting
            .Highlight = True
            '.Font.Name = "Times New Roman"
            .Text = ""
            '.Replacement.Text = "\1"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = False
            .Execute
            
            If Not Myrange Is Nothing Then
                Start = Myrange.Start
                Myrange.Copy
                newDoc.Content.InsertAfter vbCrLf
                newDoc.Range(Start:=newDoc.Content.End - 1, _
                    End:=newDoc.Content.End).Paste
                Do
                    .Execute
                    If Myrange Is Nothing Or Myrange.Start = Start Then Exit Do
                    Myrange.Copy
                    newDoc.Content.InsertAfter vbCrLf
                    newDoc.Range(Start:=newDoc.Content.End - 1, _
                        End:=newDoc.Content.End - 1).Paste
                Loop
            End If
        End With
    End With
    newDoc.Content.HighlightColorIndex = wdNoHighlight
    newDoc.Activate
    Application.ScreenUpdating = True
End Sub
[/vba]


Замечательный Временно просто медведь , процентов на 20.

Сообщение отредактировал bmv98rus - Суббота, 21.03.2020, 16:34
 
Ответить
Сообщениену я б в цикле поискал Find.HitHighlight и найденное переносил. И тоже согласен с Андреем - на вопрос можно ответ или да или нет. Судя по всему вы хотите получить готовый макрос, что совершенно о другом.

[vba]
Код
Sub CopyHiglighted()
Application.ScreenUpdating = False
    
Set Sourcedoc = ThisDocument
Set Myrange = ThisDocument.Content
Set newDoc = Documents.Add(Template:="Normal", NewTemplate:=False, DocumentType:=0)
Sourcedoc.Activate
    With Myrange
        With .Find
            .ClearFormatting
            .Highlight = True
            '.Font.Name = "Times New Roman"
            .Text = ""
            '.Replacement.Text = "\1"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = False
            .Execute
            
            If Not Myrange Is Nothing Then
                Start = Myrange.Start
                Myrange.Copy
                newDoc.Content.InsertAfter vbCrLf
                newDoc.Range(Start:=newDoc.Content.End - 1, _
                    End:=newDoc.Content.End).Paste
                Do
                    .Execute
                    If Myrange Is Nothing Or Myrange.Start = Start Then Exit Do
                    Myrange.Copy
                    newDoc.Content.InsertAfter vbCrLf
                    newDoc.Range(Start:=newDoc.Content.End - 1, _
                        End:=newDoc.Content.End - 1).Paste
                Loop
            End If
        End With
    End With
    newDoc.Content.HighlightColorIndex = wdNoHighlight
    newDoc.Activate
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - bmv98rus
Дата добавления - 21.03.2020 в 10:21
anvg Дата: Воскресенье, 22.03.2020, 21:01 | Сообщение № 6
Группа: Друзья
Ранг: Ветеран
Сообщений: 581
Репутация: 271 ±
Замечаний: 0% ±

2016, 365
bmv98rus, Михаил, а как же ограничение в десять строк? Весна - пошла потеха? :D
 
Ответить
Сообщениеbmv98rus, Михаил, а как же ограничение в десять строк? Весна - пошла потеха? :D

Автор - anvg
Дата добавления - 22.03.2020 в 21:01
bmv98rus Дата: Воскресенье, 22.03.2020, 21:14 | Сообщение № 7
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4098
Репутация: 766 ±
Замечаний: 0% ±

Excel 2013/2016
Андрей, 10 - это в Excel. :-) Word - он же текстовый процессор, тут можно и больше :-) , да и добавить то пришлось к коду предыдущей темы всего ничего .


Замечательный Временно просто медведь , процентов на 20.

Сообщение отредактировал bmv98rus - Воскресенье, 22.03.2020, 21:16
 
Ответить
СообщениеАндрей, 10 - это в Excel. :-) Word - он же текстовый процессор, тут можно и больше :-) , да и добавить то пришлось к коду предыдущей темы всего ничего .

Автор - bmv98rus
Дата добавления - 22.03.2020 в 21:14
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Скопировать выделенный текст в отдельный файл макросом.
  • Страница 1 из 1
  • 1
Поиск:

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