Содержание:
Макрос для создания ссылок в Оглавлении
Макрос для замены "крякозяб" из буфера
Макрос для создания шрифтов при копировании из pdf в doc
Таблица Excel для преобразования размеров рисунков на созданных html-страницах.
Макрос для создания ссылок в Оглавлении
Sub lim84() 'Макрос для установки ссылок в оглавлении
'Создаем Оглавление, состоящее из текстов заголовков разделов (глав)
'Строка в Оглавлении должна быть тождественна названию раздела (главы)
'В конце Оглавления добавляем строку (метку) 1234567. По её достижению
'процесс формирования ссылок прекращается
'Перед первой строкой Оглавления помещаем курсор и запускаем Макрос
'Теперь каждая строка Оглавления будет иметь вид
' <a href=""#" & i & """>Глава, в которой говорится о...</a>
'Каждая соответствующая одноименная Глава будет иметь вид:
'<a name=""" & i & """></a><b> Глава, в которой говорится о...</b>
'Где символ i = 1, 2, 3 ... 1000 соответствует номеру строки в Оглавлении
'
' lim84 Мaкрос
'
'
' создaн вручную копированием из lim85 Мaкрос
'
'
For i = 1 To 1000
Selection.TypeText Text:="<a href=""#" & i & """>"
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy
'тaким хитрым способом подменяем зaмену из буферa обменa
replasetext = Selection
'прекращаем преобразование, если встретим метку
metka = "1234567" & Chr(13)
'MsgBox ("Texxxxt - " & replasetext & " metka - " & metka) ' команда для отладки Макроса
If replasetext = metka Then Exit Sub
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</a>return"
'Selection.Find.ClearFormatting
'Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = replasetext
.Replacement.Text = "<a name=""" & i & """></a><b> ^c</b>"
'^c - содержимое буфера обмена. Заполняется командой Selection.Copy
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
'Selection.Find.ClearFormatting
'Selection.Find.Replacement.ClearFormatting
With Selection.Find
'удаляем "хитрую" подмену буфера обмена
.Text = "return"
.Replacement.Text = ""
.Forward = True
' .Wrap = wdFindAsk
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
Selection.EndKey Unit:=wdLine
Selection.MoveRight Unit:=wdCharacter, Count:=1
Next
End Sub
'Текст макроса в формате "как есть" в тегах <xmp>
Макрос для замены "крякозяб" из буфера
При копировании текста макроса Word или Excel кириллица (комментарии) превращается в нечитаемые коды. Макрос преобразует в документе Word такие символы в читаемые. Правда, после ряда экспериментов из Excel макросы стали копироваться корректно.
Sub Замена_символов00()
'
' Замена_символов00 Макрос
'
'В цикле просматриваем каждый нечитаемый символ, которые имеют коды 192-255
For i = 192 To 255
'Создаем шаблон правильной кодировки
Alphabet = "АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя"
'Каждому значению переменной цикла соответствует правильный символ:
replacer = Mid(Alphabet, i - 191, 1) 'Вычитаем 191, поскольку в шаблоне нумерация с 1
'И символ не читаемый:
search = ChrW(i)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
'Находим символ не читаемый:
.Text = search
'И заменяем его на правильный:
.Replacement.Text = replacer
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
End Sub
Этот же макрос приводим в виде "как есть", просто копируя его текст из VBA
Макрос для создания шрифтов при копировании из pdf в doc
При копировании текстов из статей в pdf-формате в документы *doc текст копии нечитаем. В частности, это относится к статьям сайта УФН. Макрос позволяет изменить кодировку символов на вордовскую. Копируем текст из pdf в doc и запускаем макрос.
'Текст макроса в формате "как есть" в тегах <xmp>
Таблица для преобразования размеров рисунков на созданных html-страницах.
Если необходимо в массовом порядке изменить размеры рисунков, то можно использовать следующую excel-таблицу.
Каждая строка содержит формулы для преобразования. Сначала необходимо заполнить первую колонку параметрами рисунка. Для этого на html-странице открываем свойства первого рисунка. Затем последовательно копируем параметры всех рисунков, не забывая записать и его номер. Параметры рисунка заносим в первую колонку, а его номер - в колонку F.
Сразу же после внесения параметров рисунка с html-страницы, появится строчка его размеров - колонка E. Если на странице размер рисунка нас не устраивает, то его можно изменить просто задав масштаб в колонке В (имя колонки М - масштаб). Колонки G-X - вспомогательные, их не нужно трогать.
Теперь копируем желтую область - колонки Е-F и копируем текст размера рисунка в его код на странице. В колонке L (имя колонки тоже М-масштаб) появится фактический масштаб, установленный на странице. Можно его сохранить, тогда изменений в код рисунка вносить не надо. В текстовом виде формулы в ячейках приведены в следующей таблице. Левая колонка - текст формулы для строки 2, правая - имя колонки на листе Excel. Остальные строки создаются простым протягиванием.
|
788px в 462px (в масштабе 615px в 360px) |
A |
|
=L2 |
B |
|
=ОКРУГЛ(B2*H2;0) |
C |
|
=ОКРУГЛ(B2*I2;0) |
D |
|
="width="""&C2&""" height="""&D2&"""" |
E |
|
1 |
F |
|
|
G |
|
=ПСТР(A2;1;N2)+0 |
H |
|
=ПСТР($A2;P2;R2)+0 |
I |
|
=ПСТР($A2;S2;U2)+0 |
J |
|
=ПСТР($A2;V2;X2)+0 |
K |
|
=J2/H2 |
L |
|
|
M |
|
=НАЙТИ( "px";$A2;1)-1 |
N |
|
=N2 |
O |
|
=НАЙТИ( "в ";$A2;O2)+2 |
P |
|
=НАЙТИ( "px";$A2;P2-3) |
Q |
|
=Q2-P2 |
R |
|
=НАЙТИ( "табе ";$A2;1)+5 |
S |
|
=НАЙТИ( "px";$A2;S2) |
T |
|
=T2-S2 |
U |
|
=НАЙТИ( "в ";$A2;P2+1)+2 |
V |
|
=НАЙТИ( "px";$A2;V2) |
W |
|
=W2-V2 |
X |