Добрый вечер! Скажите, пожалуйста, как преобразовать списки в текст?
Запускайте процедуру "pLists". Процедура "pConvertLists" будет запущена процедурой "pLists".
Макрос
Sub pLists()
' Превращение списков в текст и некоторые настройки.
Call pConvertLists
MsgBox "Готово.", vbInformation
End Sub
Private Sub pConvertLists()
' Превращение списков в текст и некоторые настройки.
Dim par As Paragraph
Dim lngSign As Long, i As Long
For i = ActiveDocument.ListParagraphs.Count To 1 Step -1
' Vba-именование абзаца.
Set par = ActiveDocument.ListParagraphs(i)
' Если абзац внутри таблицы, то не обрабатываем такой абзац.
If par.Range.Information(wdWithInTable) = True Then
GoTo metkaNextListPar
End If
' Запись юникод-кода маркера.
lngSign = AscW(par.Range.ListFormat.ListString)
' Если маркер это тире (-4051) или дефис (45).
If (lngSign = -4051) Or (lngSign = 45) Then
' Превращение списка в текст.
par.Range.ListFormat.ConvertNumbersToText
' Замена дефиса на тире.
If lngSign = 45 Then
par.Range.Characters(1).Text = ChrW(-4501)
End If
' Настройка параметров абзаца.
par.LeftIndent = CentimetersToPoints(0)
par.RightIndent = CentimetersToPoints(0)
par.FirstLineIndent = CentimetersToPoints(1.25)
' Установка табуляции.
par.Range.ParagraphFormat.TabStops.ClearAll
par.Range.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(1.75), _
Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
End If
metkaNextListPar:
Next i
End Sub
Большое спасибо! Проверила - на моих маркированных списках работает.
Добрый день!
Мне что-то везет на необычные варианты документов с ошибками. Есть у меня документ, использую макрос из этой темы, а он выдает ошибку. Прикрепил. Как можно избежать ошибки? Хочется, чтобы макрос все-таки отработал весь документ до конца.
Наверное, очередной брак в ворде: списков нет, но vba и сам ворд видит список (вкладка "Главная" - группа "Абзац" - вдавлена кнопка маркированных списков "Маркеры"). По идее, если есть список, значит должен быть маркер. Или есть списки без маркеров?
Макрос
Sub pLists()
' Превращение списков в текст и некоторые настройки.
Call pConvertLists
MsgBox "Готово.", vbInformation
End Sub
Private Sub pConvertLists()
' Превращение списков в текст и некоторые настройки.
Dim par As Paragraph
Dim lngSign As Long, i As Long
For i = ActiveDocument.ListParagraphs.Count To 1 Step -1
' Vba-именование абзаца.
Set par = ActiveDocument.ListParagraphs(i)
' Если абзац внутри таблицы, то не обрабатываем такой абзац.
If par.Range.Information(wdWithInTable) = True Then
GoTo metkaNextListPar
End If
' Если в абзаце нет маркеров. Это наверное брак в ворде.
If par.Range.ListFormat.ListString = "" Then
GoTo metkaNextListPar
End If
' Запись юникод-кода маркера.
lngSign = AscW(par.Range.ListFormat.ListString)
' Если маркер это тире (-4051) или дефис (45).
If (lngSign = -4051) Or (lngSign = 45) Then
' Превращение списка в текст.
par.Range.ListFormat.ConvertNumbersToText
' Замена дефиса на тире.
If lngSign = 45 Then
par.Range.Characters(1).text = ChrW(-4501)
End If
' Настройка параметров абзаца.
par.LeftIndent = CentimetersToPoints(0)
par.RightIndent = CentimetersToPoints(0)
par.FirstLineIndent = CentimetersToPoints(1.25)
' Установка табуляции.
par.Range.ParagraphFormat.TabStops.ClearAll
par.Range.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(1.75), _
Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
End If
metkaNextListPar:
Next i
End Sub
Но что-то на моем примере у меня ничего не происходит.
А что должно происходить?
Ну список должен быть текстом, а кнопка список все также утоплена.
Макрос
Sub pLists()
' Превращение списков в текст и некоторые настройки.
Call pConvertLists
MsgBox "Готово.", vbInformation
End Sub
Private Sub pConvertLists()
' Превращение списков в текст и некоторые настройки.
Dim par As Paragraph
Dim lngSign As Long, i As Long
For i = ActiveDocument.ListParagraphs.Count To 1 Step -1
' Vba-именование абзаца.
Set par = ActiveDocument.ListParagraphs(i)
' Если абзац внутри таблицы, то не обрабатываем такой абзац.
If par.Range.Information(wdWithInTable) = True Then
GoTo metkaNextListPar
End If
' Если в абзаце нет маркеров. Это наверное брак в ворде.
If par.Range.ListFormat.ListString = "" Then
par.Range.ListFormat.ConvertNumbersToText
GoTo metkaNextListPar
End If
' Запись юникод-кода маркера.
lngSign = AscW(par.Range.ListFormat.ListString)
' Если маркер это тире (-4051) или дефис (45).
If (lngSign = -4051) Or (lngSign = 45) Then
' Превращение списка в текст.
par.Range.ListFormat.ConvertNumbersToText
' Замена дефиса на тире.
If lngSign = 45 Then
par.Range.Characters(1).text = ChrW(-4501)
End If
' Настройка параметров абзаца.
par.LeftIndent = CentimetersToPoints(0)
par.RightIndent = CentimetersToPoints(0)
par.FirstLineIndent = CentimetersToPoints(1.25)
' Установка табуляции.
par.Range.ParagraphFormat.TabStops.ClearAll
par.Range.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(1.75), _
Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
End If
metkaNextListPar:
Next i
End Sub
Да! Ура! Все сработало! Огромное спасибо за помощь и терпение!
Здравствуйте!
У меня сходная проблема: в большом документе (примерно 500 стр.) нужно заменить маркированный список на текст (вместо маркера - тире (En Dash)). В маркированном списке стоят длинные тире, но шрифт у этих маркеров - "Symbol". Видимо, из-за этого у меня не получается задать в коде макроса условие поиска - код этого длинного тире.
Вы не могли бы подсказать, какой код использовать?
Фрагмент файла приложил.
Большое спасибо!
[вложение удалено администратором]
Для вашего файла макрос.
Макрос
Sub макрос()
Dim par As Paragraph, marker As Long, i As Long
' Отключение монитора (может это ускорит макрос).
Application.ScreenUpdating = False
' Цикл по всем абзацам, в которых есть список.
' Цикл от последнего к первому, т.к. после замены списка на текст
' абзац не будет содержать список и нумерация абзацев-списков изменится
' и переход уже не произойдёт к нужному абзацу-списку, а будет перескок.
For i = ActiveDocument.ListParagraphs.Count To 1 Step -1
'1. Присваиваем абзацу имя "par", чтобы было удобно читать и писать код.
Set par = ActiveDocument.ListParagraphs(i)
'2. Запись юникод-кода маркера в переменную "marker".
marker = AscW(par.Range.ListFormat.ListString)
' Смотрим, что в переменной "marker".
Select Case marker
' Если маркер это тире или дефис.
' -4051, -3906 - тире.
' 45 - дефис.
Case -3906, -4051, 45
'3. Превращение списка в текст.
par.Range.ListFormat.ConvertNumbersToText
'4. Задаём шрифт для маркера и для символа "табуляция". Шрифт будет, как у текста.
' Для этого смотрим шрифт третьего символа абзаца.
' У маркера делаем шрифт, чтобы тире выглядело как тире.
' У символа "табуляция" изменяем шрифт просто, чтобы не было
' ничего лишнего в файле.
par.Range.Characters(1).Font.Name = par.Range.Characters(3).Font.Name
par.Range.Characters(2).Font.Name = par.Range.Characters(3).Font.Name
'5. Замена тире, дефиса на тире "En Dash".
par.Range.Characters(1).Text = Chr(150)
'6. Замена символа "табуляция" на неразрывный пробел, чтобы текст был рядом с тире.
par.Range.Characters(2).Text = Chr(160)
End Select
Next i
' Вкл. монитора.
Application.ScreenUpdating = True
'6. Сообщение.
MsgBox "Готово.", vbInformation
End Sub
Большое спасибо!
Всё работает! Это великолепно!