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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 11.11.2010, 01:37   #1
krad3
 
Регистрация: 11.11.2010
Сообщений: 4
По умолчанию преобразование многоуровневого списка в таблицу

Доброго времени суток! Подскажите, возможно ли штатными средствами Word'а преобразовать многоуровневый список в таблицу?

Имеется список вида:
1. К функциям общения относится:
a. Использование ведущих каналов восприятия информации;
b. Передача и прием информации;
c. Использование средств общения.
2. Общение подразделяется на…
a. Диалогическое и монологическое;
b. Вербальное и невербальное;
c. Визуальное, аудиальное и кинестетическое.

На выходе должно быть:
___________________________________ _____________________________
|1. К функциям общения относится:|2. Общение подразделяется на…----|
|a. Использование ведущих каналов|a.Диалогическое и монологическое;|
| восприятия информации;---------|------------------------------------|
---------------. . .-----------------|---------------. . .-------------------

Количество элементов второго уровня разное - от 3 до 7. Получается, что новая ячейка должна содержать строку, начинающуюся с цифры + все последующие до следующего появления цифры в начале строки
krad3 вне форума Ответить с цитированием
Старый 11.11.2010, 10:19   #2
Вождь
Форумчанин
 
Аватар для Вождь
 
Регистрация: 29.09.2008
Сообщений: 378
По умолчанию

Стандартными средствами не получится.

Руками поэтапно:
1. Создаем таблицу нужного размера
2. Вырезаем и вставляем уровни списка в пустые столбцы

А обязательно в таблицу? Если преобразовать в колонки, будет очень похоже. Тут можно автоматизировать, если уровни стилизованы или еще как-то выделены:
1. Преобразуем список в колонки
2. Поиском и заменой или руками вставляем разрыв колонки перед каждым уровнем
Макросы на заказ и готовый пакет - http://mtdmacro.ru/

Последний раз редактировалось Вождь; 11.11.2010 в 10:22.
Вождь вне форума Ответить с цитированием
Старый 11.11.2010, 11:13   #3
forumWord
Пользователь
 
Регистрация: 23.09.2010
Сообщений: 65
По умолчанию

krad3, списки автоматические или от руки цифры и буквы набиты?

Можно штатными средствами сделать:
1. Выделите весь список.
2. Таблица - Вставить таблицу (что-то в этом роде, т.к. я не знаю, какой у вас Word). Если будут какие-то диалоговые окна, то всегда жмите ОКЕЙ.
3. В результате наш список превратился в таблицу.
4. Выделите строки, которые нужно поместить в столбец справа - Вырежте их (Ctrl + X).
5. Поместите курсор в позицию, указанную на рис.
6. Вставьте вырезанное (Ctrl + V).

Хотя нумерация сбивается. В таблицах нумерация идёт не так, как надо, если используются автоматические списки. Как это решить - не знаю. Единственное, что приходит в голову, - преобразовать списки в просто текст (если они автоматические были). Можно ли это сделать штатными средствами - не знаю, но можно с помощью макросов.
Изображения
Тип файла: jpg Многоуровневый список..jpg (51.6 Кб, 153 просмотров)

Последний раз редактировалось forumWord; 11.11.2010 в 12:10.
forumWord вне форума Ответить с цитированием
Старый 11.11.2010, 20:23   #4
krad3
 
Регистрация: 11.11.2010
Сообщений: 4
По умолчанию

Office 2007, списки автоматические. С ручным разнесением вопросов из списка в общем-то нет. Интересует именно процесс автоматизации. Очень часто приходится разбивать вопросы по вариантам (только не предлагайте воспользоваться программами для составления тестов - у меня жена против них))). Пробую реализовать разброс в офисе - например на 3 (4, 5) варианта, чтоб можно было как при преобразовании текста в таблицу указать количество столбцов (=вариантов). Может что-то с символами в конце строки придумать...?
krad3 вне форума Ответить с цитированием
Старый 12.11.2010, 00:20   #5
Вождь
Форумчанин
 
Аватар для Вождь
 
Регистрация: 29.09.2008
Сообщений: 378
По умолчанию

Макрос переносит параграфы выбранной области в таблицу. Новая колонка - параграф списка первого уровня. Область может содержать и параграфы с обычным текстом. Ну и комментарии имеются…
Код:
Public Sub Выбранные_параграфы_в_таблицу()
    Lists_ConvertToTable Selection.Range
End Sub

Public Sub Lists_ConvertToTable( _
    ByRef lcRange As Word.Range, _
    Optional ByRef lcTable As Word.Table)
' преобразовать текст в таблицу с учетом списков
'   разделитель строк - знак абзаца (параграф)
'   разделитель столбцов - параграф списка 1-го уровня
' lcRange - вход: область текста
' lcTable - выход: созданная таблица

    'On Error Resume Next ' тест
    Set lcTable = Nothing
    If lcRange Is Nothing Then Exit Sub
    If lcRange.Tables.Count > 0 Then Exit Sub
    ' параграфы целиком
    lcRange.Expand Unit:=Word.wdParagraph

Dim P As Word.Paragraph
Dim R As Word.Range
Dim nR&, nC&, N&
    
    ' размеры таблицы
    nR = 0: nC = 0
    Set R = lcRange.Duplicate
    R.Collapse Direction:=Word.wdCollapseEnd
    For Each P In lcRange.ListParagraphs
        With P.Range
            ' первый уровень
            If .ListFormat.ListLevelNumber <> 1 Then
            Else
                ' новый столбец
                nC = nC + 1
                ' строк в столбце
                R.Start = .Start
                N = R.Paragraphs.Count
                If N > nR Then nR = N
                ' позиция
                R.Collapse Direction:=Word.wdCollapseStart
            End If
        End With
    Next P
    If R.End > lcRange.Start Then
        ' новый столбец
        nC = nC + 1
        ' строк в столбце
        R.Start = lcRange.Start
        N = R.Paragraphs.Count
        If N > nR Then nR = N
    End If
    
    ' место для таблицы
    Set R = lcRange.Characters.Last
    R.InsertParagraphBefore
    R.InsertParagraphBefore
    lcRange.MoveEnd Unit:=Word.wdCharacter, Count:=-2
    R.MoveStart Unit:=Word.wdCharacter, Count:=1
    R.ParagraphFormat.Reset
    R.MoveStart Unit:=Word.wdCharacter, Count:=1
    R.Collapse Direction:=Word.wdCollapseStart
        
    ' создание таблицы
    Set lcTable = R.Tables.Add( _
                    Range:=R, NumRows:=nR, NumColumns:=nC)
    If lcTable Is Nothing Then Exit Sub
    lcTable.Style = Word.wdStyleNormalTable
    
    ' перенос текста в таблицу
    Set R = lcRange.Duplicate
    R.Collapse Direction:=Word.wdCollapseEnd
    For Each P In lcRange.ListParagraphs
        With P.Range
            ' первый уровень
            If .ListFormat.ListLevelNumber <> 1 Then
            Else
                R.Start = .Start
                GoSub sub_Range
                R.Collapse Direction:=Word.wdCollapseStart
            End If
        End With
    Next P
    If R.End > lcRange.Start Then
       R.Start = lcRange.Start
       GoSub sub_Range
    End If
    Exit Sub
    
sub_Range: ' перенос области R в столбец nC
    
    ' число параграфов - строк таблицы
    nR = R.Paragraphs.Count
    ' переносим
    R.Cut
    lcTable.Cell(1, nC).Select
    If nR <= 1 Then
        Selection.Paste
        If Selection.Start = Selection.Paragraphs.First.Range.Start Then
            Selection.TypeBackspace
        End If
    Else
        Selection.MoveDown _
            Unit:=Word.wdLine, _
            Count:=nR - 1, _
            Extend:=Word.wdExtend
        Selection.Paste
    End If
    ' свободный столбец
    nC = nC - 1
    Return
    
End Sub
Макросы на заказ и готовый пакет - http://mtdmacro.ru/
Вождь вне форума Ответить с цитированием
Старый 12.11.2010, 01:50   #6
krad3
 
Регистрация: 11.11.2010
Сообщений: 4
Хорошо

Вождь, к сожалению не нашел кнопки изменения репутации... ОГРОМНОЕ спасибо за помощь! Обычно отсылают в поиск, дают "приблизительные" советы, а тут в кратчайшие сроки и готовое решение))) Еще раз спасибо! Скажите, можно ли в этот код вносить свои изменения?
P.S. Нашел!)

Последний раз редактировалось krad3; 12.11.2010 в 01:59.
krad3 вне форума Ответить с цитированием
Старый 12.11.2010, 02:03   #7
Вождь
Форумчанин
 
Аватар для Вождь
 
Регистрация: 29.09.2008
Сообщений: 378
По умолчанию

Цитата:
Сообщение от krad3 Посмотреть сообщение
Скажите, можно ли в этот код вносить свои изменения?
Да, на здоровье. Код тестирован, но все же сырой...
Макросы на заказ и готовый пакет - http://mtdmacro.ru/
Вождь вне форума Ответить с цитированием
Старый 12.11.2010, 09:53   #8
forumWord
Пользователь
 
Регистрация: 23.09.2010
Сообщений: 65
По умолчанию

krad3, не хочу проверять код вождя. Просто ради интереса. Списки нормально нумеруются в таблице? Я просто переносил список в таблицу и нумерация сбивалась: она идёт не по столбцам, а слева направо.
forumWord вне форума Ответить с цитированием
Старый 12.11.2010, 12:33   #9
krad3
 
Регистрация: 11.11.2010
Сообщений: 4
По умолчанию

Нет, действительно сбиваются: нумеруются как один большой список слева направо. на данный момент я по столбцам объединяю ячейки со списком второго уровня и выбираю "начать нумерацию сначала" в каждой объединенной ячейке
krad3 вне форума Ответить с цитированием
Старый 12.11.2010, 14:29   #10
Вождь
Форумчанин
 
Аватар для Вождь
 
Регистрация: 29.09.2008
Сообщений: 378
По умолчанию

Цитата:
Сообщение от krad3 Посмотреть сообщение
Нет, действительно сбиваются...
Естественно. Нумерация принимает последовательный вид. Чтобы понять как это, надо преобразовать таблицу в текст и присмотреться к порядку параграфов. Например, даже если ячейки со списком расположить по диагонали, то нумерация будет последовательной.

Для сохранения нумерации, все подуровни уровня списка должны находиться в одной с ним ячейке. Мой макрос, этого не учитывает. В нем так и написано: разделитель строк - знак абзаца. А макрос для одной строки будет покороче, а еще проще мой макрос сделать универсальным:
Код:
Public Sub Table_ConvertListToColumns( _
    ByRef lcRange As Word.Range, _
    Optional ByVal lcLevel As Byte = 1, _
    Optional ByVal lcOneRow As Boolean = False, _
    Optional ByRef lcTable As Word.Table)
' преобразовать текст в таблицу с учетом списков
'   разделитель столбцов - параграф списка заданного уровня
' lcRange - вход: область текста
' lcLevel - вход: номер уровня-разделителя (1-9)
' lcOneRow - вход: разделение на строки:
'   True - без разделения - одна строка
'   False - разделитель - знак абзаца (параграф)
' lcTable - выход: созданная таблица

    On Error Resume Next
    Set lcTable = Nothing
    If lcRange Is Nothing Then Exit Sub
    If lcRange.Tables.Count > 0 Then Exit Sub
    If (lcLevel <= 0) Or (lcLevel > 9) Then lcLevel = 1
    ' параграфы целиком
    lcRange.Expand Unit:=Word.wdParagraph
    
Dim P As Word.Paragraph
Dim R As Word.Range
Dim nR&, nC&, N&
    
    ' размеры таблицы
    nR = 0: nC = 0
    Set R = lcRange.Duplicate
    R.Collapse Direction:=Word.wdCollapseEnd
    For Each P In lcRange.ListParagraphs
        With P.Range
            ' номер уровеня
            If .ListFormat.ListLevelNumber <> lcLevel Then
            Else
                ' новый столбец
                nC = nC + 1
                ' строк в столбце
                R.Start = .Start
                N = R.Paragraphs.Count
                If N > nR Then nR = N
                ' позиция
                R.Collapse Direction:=Word.wdCollapseStart
            End If
        End With
    Next P
    If R.End > lcRange.Start Then
        ' новый столбец
        nC = nC + 1
        ' строк в столбце
        R.Start = lcRange.Start
        N = R.Paragraphs.Count
        If N > nR Then nR = N
    End If
    
    ' место для таблицы
    Set R = lcRange.Characters.Last
    R.InsertParagraphBefore
    R.InsertParagraphBefore
    lcRange.MoveEnd Unit:=Word.wdCharacter, Count:=-2
    R.MoveStart Unit:=Word.wdCharacter, Count:=1
    R.ParagraphFormat.Reset
    R.MoveStart Unit:=Word.wdCharacter, Count:=1
    R.Collapse Direction:=Word.wdCollapseStart
        
    ' создание таблицы
    If lcOneRow Then nR = 1
    Set lcTable = R.Tables.Add( _
                    Range:=R, NumRows:=nR, NumColumns:=nC)
    If lcTable Is Nothing Then Exit Sub
    lcTable.Style = Word.wdStyleNormalTable
    
    ' перенос текста в таблицу
    Set R = lcRange.Duplicate
    R.Collapse Direction:=Word.wdCollapseEnd
    For Each P In lcRange.ListParagraphs
        With P.Range
            ' номер уровеня
            If .ListFormat.ListLevelNumber <> lcLevel Then
            Else
                R.Start = .Start
                GoSub sub_Range
                R.Collapse Direction:=Word.wdCollapseStart
            End If
        End With
    Next P
    If R.End > lcRange.Start Then
       R.Start = lcRange.Start
       GoSub sub_Range
    End If
    Exit Sub
    
sub_Range: ' перенос области R в столбец nC
    
    ' число параграфов - строк таблицы
    nR = R.Paragraphs.Count
    ' переносим
    R.Cut
    lcTable.Cell(1, nC).Select
    If (nR <= 1) Or (lcOneRow = True) Then
        Selection.Paste
        If Selection.Start = Selection.Paragraphs.First.Range.Start Then
            Selection.TypeBackspace
        End If
    Else
        Selection.MoveDown _
            Unit:=Word.wdLine, _
            Count:=nR - 1, _
            Extend:=Word.wdExtend
        Selection.Paste
    End If
    ' следующий столбец
    nC = nC - 1
    Return
    
End Sub
Для сохранения нумерации параметр lcOneRow задать True.
Макросы на заказ и готовый пакет - http://mtdmacro.ru/

Последний раз редактировалось Вождь; 12.11.2010 в 14:50.
Вождь вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как отфильтровать таблицу по значениям из выпадающего списка? Умница++ Microsoft Office Excel 14 20.07.2011 12:19
Как добавить значения из списка с множественным выбором в таблицу/запрос? NickiBell Microsoft Office Access 0 24.09.2010 00:38
Необходимо сделать из списка таблицу Azz100 Microsoft Office Excel 2 24.08.2010 10:28
Сохранить значение из списка в таблицу Botanik1987 Microsoft Office Access 14 13.04.2010 18:17
[Prolog] Преобразование списка в таблицу girlll Помощь студентам 1 07.04.2009 23:29