И вставка в текст HTML-тегов.
Так вот. Написал я в Word’е заметку про какой-нибудь скрипт, красиво оформил, код выделен Курьером, заголовки отцентрованы, важные места выделены жирным, пункты меню указаны курсивом, ну и так далее. Теперь нужно текст переложить в уютненький бложег, да так, чтобы сохранить форматирование вставить куда надо нужные теги.
Встроенное сохранение в формате HTML вставляет много лишних тегов, добавлять нужные теги руками – лишняя работа, а я ленивый. Что же делать? У нас есть VBA, который все сам за нас сделает.
Найдем, например, первое вхождение текста, который выделен жирным:
Selection.Find.ClearFormatting 'Очистка параметров поиска
With Selection.Find
.Font.Bold = True 'найдем текст, выделенный жирным
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute 'запуск поиска
Этот фрагмент кода, будучи вставлен в исполнимый макрос найдет первое вхождение текста выделенного жирным
Найдем текст, выделенный определенным шрифтом, например
Courier New
Selection.Find.ClearFormatting 'Очистка параметров поиска
With Selection.Find
.Font.NameAscii = "Courier New" 'найдем текст, выделенный Курьером
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute 'запуск поиска
Или текст, который расположен по центру:
Selection.Find.ClearFormatting 'Очистка параметров поиска
With Selection.Find
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute 'запуск поиска
Ищем нужное
Selecton.Text и присваивай ему значение "открывающий_тег"+Selection.Text+"закрывающий_тег", да не тут-то было. Во-первых, Selection.Find.Execute имеет дурацкое свойство искать не кусок текста от и до, а искать по абзацам, т.е.Если этот параграф выделен Курьером
И следующий тожеFind.Excecute выделит нам только первый абзац, для поиска остальных операцию придется повторять в цикле, но и это еще не все. Если мы сразу будем вставлять теги, то получится много лишних. Несмотря на то, что абзацы с одинаковым оформлением пусть даже и идут друг за другом, функция поиска будет рассматривать каждый абзац, как отдельный случай. Посему, все найденные данные стоит сначала собрать в массив(ы):
Dim Start_s() As Long ' Массив, для хранения стартовых
' позиций найденных блоков
Dim End_s() As Long ' Массив, для хранения конечных позиций
' найденных блоков
Dim I As Long ' переменная для цикла
ctr = 0 ' Количество найденных элементов
shiftctr = 0 'Счетчик сдвигов (см. далее)
Selection.Find.Execute ' Выполняем первый поиск по ранее установленным условиям
If Not Selection.Find.Found Then Exit Sub ' Если ничего не нашли - уходим
Do While Selection.Find.Found 'ищем в цикле все остальное, пока что-нибудь находится
ctr = ctr + 1
ReDim Preserve Start_s(ctr) 'переопределяем размерность массива
ReDim Preserve End_s(ctr) ' с сохранением ранее установленных элементов (ключевое слово Preserve)
Start_s(ctr) = Selection.Start 'сохраняем начальную позицию найденного текста
End_s(ctr) = Selection.End 'и конечную
Selection.Find.Execute ' выполняем поиск в цикле
Loop
Но, как я уже говорил, find ищет по абзацам, в результате в наших массивах окажется несколько идущих друг за другом подряд абзацев с одинаковым шрифтом. Конечное значение таких интервалов будет совпадать с началом следующего.Чтобы не вставлять лишние теги, проанализируем это условие, и сдвинем массив на нужное количество элементов.
Private Sub ShiftArr(ByRef arr As Variant, pos As Long, ctr As Long)
For I = 1 To ctr
For J = pos To UBound(arr) - 1
arr(J) = arr(J + 1)
Next J
Next I
End Sub
For I = 1 To ctr - 1
Do While End_s(I) = Start_s(I + 1)
ShiftArr Start_s, I + 1, 1
ShiftArr End_s, I, 1
shiftctr = shiftctr + 1
Loop
Next I
Теперь переопределим размерность массивов, обрезав ненужные элементы (для того мы и сохраняли счетчик сдвигов в переменной
shiftctr)Примечание: Функция
UBound (массив) возвращает количество его элементов, его размерность.
ReDim Preserve Start_s(UBound(Start_s) - shiftctr)
ReDim Preserve End_s(UBound(End_s) - shiftctr)
Все это я объединил в отдельную процедуру, куда передаю только сами теги, а параметры поиска устанавливаю перед ее выполнением.
В переменной TagLen будет содержаться длина открывающего и закрывающего тега, а переменная AllTagLen – накапливать суммарные длины всех вставленных тегов.
TagLen = Len(OpenTag) + Len(CloseTag)
AllTagLen = TagLen
For I = 1 To UBound(Start_s)
Selection.Start = Start_s(I)
Selection.End = End_s(I)
Selection.Text = OpenTag + Selection.Text + CloseTag
If I <> UBound(Start_s) Then
Start_s(I + 1) = Start_s(I + 1) + AllTagLen
End_s(I + 1) = End_s(I + 1) + AllTagLen
AllTagLen = AllTagLen + TagLen
End If
Next I
End Sub
Конечно, макрос можно еще долго дорабатывать – например, сделать так, чтоб перед многострочным кодом вставлялись теги pre, для сохранения форматирования, сделать автоматическую вставку тегов a href (брать для них информацию из ссылок, заключенных в квадратные скобки), заменять специальные символы на последовательности HTML, и т.д. Но все это, во-первых, уж совсем специфично, а во-вторых, меня пока и так устраивает. Кое-что не влом и вручную подправить. Но может быть еще вернусь к теме.
Это перепост заметки из моего блога на LJ.ROSSIA.ORG
Оригинал находится здесь: http://lj.rossia.org/users/hex_laden/294478.html
Прокомментировать заметку можно по ссылке выше.
Pingback: Макрос замены форматированного текста на HTML. | Персональный блог Толика Панкова