Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.50/8: Рейтинг темы: голосов - 8, средняя оценка - 4.50
Loveren
0 / 0 / 0
Регистрация: 16.03.2016
Сообщений: 3
1

Автоматический перенос текста при переходе на новую страницу в таблице Word

16.03.2016, 13:48. Просмотров 1679. Ответов 4
Метки нет (Все метки)

Добрый день!
Помогите пожалуйста, нужно реализовать с помощью макроса автоматическое копирование текста из 1 и 2 столбца на следующую страницу (с выравниванием посередине), если был перенос текста в 3 столбце. Каждый раз перед выводом на печать ручками заполнять проблематично. Пример во вложении. Заранее благодарю! П.С.: текст замазала, т.к. конфиденциальная инфа)
0
Миниатюры
Автоматический перенос текста при переходе на новую страницу в таблице Word  
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
16.03.2016, 13:48
Ответы с готовыми решениями:

Автоматический перенос нового абзаца на новую страницу
Есть ли возможность настроить документ таким образом что бы новый абзац автоматически переносился...

Автоматический перенос с одной таблице в word в другую
Неделю ломаю голову как сделать. Есть онлайн программа, которая создает ценники по выбранному...

Автоматический перенос текста в таблице
У меня есть таблица, в ней очень длинная строка, таблице чётко заданы размеры 300px, а этот текст...

Автоматический перенос выходящего за рамки ячейки текста на новую строку
Доброго времени суток, уважаемые форумчане! Вопрос значит такой. Как реализовать перенос...

При переходе на новую страницу запустить скрипт
html. на странице расположена кнопка. при нажатии на нее перейти по ссылке на другую страницу и...

4
KoGG
5329 / 1395 / 330
Регистрация: 23.12.2010
Сообщений: 2,071
Записей в блоге: 1
16.03.2016, 17:45 2
Лучший ответ Сообщение было отмечено Loveren как решение

Решение

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Sub Дублировать_1_2_ст_при_переносе()
    Dim i%, j%, k%, S$, CellEndPage%, Tabl, Ra As Range, Line1%, Line2%, Line3%, Line4%
    For Each Tabl In ActiveDocument.Tables
        With Tabl
            For i = 1 To .Rows.Count
                .Cell(i, 3).Range.Select
                Selection.Collapse Direction:=wdCollapseStart
                Line1 = Selection.Information(wdFirstCharacterLineNumber)
                .Cell(i, 3).Range.Select
                Selection.End = Selection.End - 1
                Selection.Collapse Direction:=wdCollapseEnd
                Line4 = Selection.Information(wdFirstCharacterLineNumber)
                CellEndPage = Selection.Information(wdActiveEndPageNumber)
                Set Ra = .Cell(i, 3).Range
                Ra.End = Ra.End - 1
                With Ra
                    For j = .Start To .End
                        .Start = j
                        .End = j
                        If .Information(wdActiveEndPageNumber) = CellEndPage Then
                            Line3 = .Information(wdFirstCharacterLineNumber)
                            Exit For
                        Else
                            Line2 = .Information(wdFirstCharacterLineNumber)
                        End If
                    Next
                End With
                Set Ra = .Cell(i, 3).Range
                Ra.End = Ra.Start
                If CellEndPage > Ra.Information(wdActiveEndPageNumber) Then
                    For j = 1 To 2
                        S = .Cell(i, j).Range.Text
                        S = Left(S, Len(S) - 1)
                        While Right(S, 1) = Chr(13) Or Right(S, 1) = Chr(10)
                             S = Left(S, Len(S) - 1)
                        Wend
                        .Cell(i, j).Range.Select
                        Selection.End = Selection.End - 1
                        Selection.TypeText String((Line2 - Line1) / 2, vbCr) & S & String((Line2 - Line1 - 1 + Line4 - Line3) / 2, vbCr) & S
                        ''Do
                        ''    .Cell(i, j).Range.Select
                        ''    Selection.End = Selection.End - 1
                        ''    Selection.Start = Selection.End - 1
                        ''    PointsUp2 = Selection.Information(wdVerticalPositionRelativeToTextBoundary)
                        ''    Selection.Collapse Direction:=wdCollapseEnd
                        ''    Selection.TypeText String(PointsUp2 / 14.3, vbCr) & S
                        ''    Selection.TypeParagraph
                        ''    ActiveDocument.CountNumberedItems
                        ''Loop While Selection.Information(wdActiveEndPageNumber) < CellEndPage
                        ''Selection.TypeText S
                    Next j
                End If
            Next i
        End With
    Next Tabl
End Sub
1
Loveren
0 / 0 / 0
Регистрация: 16.03.2016
Сообщений: 3
17.03.2016, 09:19  [ТС] 3
Огромное спасибо, работает!

Добавлено через 14 часов 8 минут
KoGG, могу я еще попросить Вас расписать действия в скрипте? очень помогло бы в дальнейшей автоматизации других действий. Если не сложно)))Буду очень признательна)
0
KoGG
5329 / 1395 / 330
Регистрация: 23.12.2010
Сообщений: 2,071
Записей в блоге: 1
17.03.2016, 11:45 4
Лучший ответ Сообщение было отмечено Loveren как решение

Решение

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub Дублировать_1_2_ст_при_переносе()
    Dim i%, j%, k%, S$, CellEndPage%, Tabl, Ra As Range, Line1%, Line2%, Line3%, Line4%
    For Each Tabl In ActiveDocument.Tables ' Перебор всех таблиц в активном документе
        With Tabl   ' Работаем через символ . с очередной таблицей
            For i = 1 To .Rows.Count ' Перебор всех строк таблицы
                .Cell(i, 3).Range.Select  ' Выделяем ячейку в i-той строке столбец 3
                Selection.Collapse Direction:=wdCollapseStart ' Схлопываем выделение к началу
                Line1 = Selection.Information(wdFirstCharacterLineNumber) 'Определяем номер строки документа (не строки таблицы) где находится курсор - начало переносимой на 2 страницы ячейки
                .Cell(i, 3).Range.Select ' Выделяем ячейку в i-той строке столбец 3
                Selection.End = Selection.End - 1 ' Уменьшаем выделение с конца на 1 символ, если этого не делать то при схлопывании к концу мы выйдем за границу таблицы
                Selection.Collapse Direction:=wdCollapseEnd ' Схлопываем выделение к концу (остаемся внутри ячейки)
                Line4 = Selection.Information(wdFirstCharacterLineNumber) 'Определяем номер строки документа - конец переносимой на 2 страницы ячейки
                CellEndPage = Selection.Information(wdActiveEndPageNumber) 'Определяем номер страницы, на которой находится конец переносимой на 2 страницы ячейки
                Set Ra = .Cell(i, 3).Range ' Определяем диапазон,
                Ra.End = Ra.End - 1  ' соответствующий содержанию переносимой ячейки (без символа конца ячейки)
                With Ra
                    For j = .Start To .End ' Перебираем этот диапазон по 1 символу с начала до конца
                        .Start = j
                        .End = j
                        If .Information(wdActiveEndPageNumber) = CellEndPage Then ' Если страница равна CellEndPage, то Ra находится уже на следующей странице
                            Line3 = .Information(wdFirstCharacterLineNumber) ' Первая строка на следующей странице при переносе
                            Exit For ' Выходим из перебора
                        Else ' Если страница не равна CellEndPage, то Ra все еще находимся на предыдущей странице
                            Line2 = .Information(wdFirstCharacterLineNumber) ' последняя строка снизу на предыдущей странице в месте переноса (определяется в предыдущий шаг перед последним шагом перебора)
                        End If
                    Next
                End With
                Set Ra = .Cell(i, 3).Range ' Определяем диапазон, соответствующий содержанию переносимой ячейки
                Ra.End = Ra.Start  ' Схлопываем диапазон к началу
                If CellEndPage > Ra.Information(wdActiveEndPageNumber) Then '  Если найденное ранее CellEndPage > начала диапазона Ra, то ячейка перенесена на 2 страницы
                    For j = 1 To 2 ' Перебор столбцов 1 и 2
                        S = .Cell(i, j).Range.Text ' Запоминаем текст в переменную  S
                        S = Left(S, Len(S) - 1) ' Удаляем символ конца ячейки
                        While Right(S, 1) = Chr(13) Or Right(S, 1) = Chr(10) ' Если с конца знак абзаца или переноса строки
                             S = Left(S, Len(S) - 1) ' Удаляем их все из переменной S
                        Wend
                        .Cell(i, j).Range.Select  ' Выделяем ячейку в i-той строке столбец j
                        Selection.End = Selection.End - 1 'уменьшаем выделение на символа конца ячейки, чтобы выделить только содержимое
                        ' Гвоздь всей программы в 1 строку, заменяем  содержимое ячейки новым:
                        ' String((Line2 - Line1) / 2, vbCr) - Добавляем символы абзаца числом (Line2 - Line1) / 2 спереди текста,
                        ' S - исходный текст
                        ' String((Line2 - Line1 -1) / 2, vbCr) Добавляем символы абзаца числом (Line2 - Line1- 1) / 2 после текста, здесь мы примерно восстановили то, что уже было
                        ' String((Line4 - Line3) / 2, vbCr) Добавляем символы абзаца числом (Line4 - Line3) / 2 уже в начале следующей страницы
                        ' S - еще раз исходный текст
                        Selection.TypeText String((Line2 - Line1) / 2, vbCr) & S & String((Line2 - Line1 - 1 + Line4 - Line3) / 2, vbCr) & S
                    Next j
                End If
            Next i
        End With
    Next Tabl
End Sub
1
Loveren
0 / 0 / 0
Регистрация: 16.03.2016
Сообщений: 3
17.03.2016, 12:26  [ТС] 5
KoGG, шикарно, спасибо огромнейшее)))немного запуталась с гвоздем программы, но потом разобралась)))
0
17.03.2016, 12:26
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
17.03.2016, 12:26

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Выполнение сценария при переходе на новую страницу
В общем имеется скрипт (silent.js) который скрывает div. Как сделать так чтобы при переходе по...

Почему при переходе на новую страницу создается новая сессия?
При переходе на новую страницу сессия не сохранняетса а создаетса новая сессия проверял по id...

Как запретить смену IP в Tor browser при переходе на новую страницу
Как запретить смену IP в Tor browser при переходе на новую страницу?? переходя по ссылке из...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
5
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.