Текст макроса Convert
Sub Convert()
'
Selection.HomeKey Unit:=wdStory
With Selection.Find
.Text = "^p^p"
.Replacement.Text = "$"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "^p"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "$"
.Replacement.Text = "^p^p"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "^-"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
With ActiveDocument.Paragraphs
.LineUnitAfter = 1
.Alignment = wdAlignParagraphLeft
.FirstLineIndent = CentimetersToPoints(0.5)
End With
Selection.WholeStory
Selection.Font.Size = 12
Selection.Font.Name = "Times New Roman"
With Selection.Find
.Execute FindText:=" ", Forward:=True
While .Found = True
.Replacement.Text = " "
.Execute Replace:=wdReplaceAll
Application.Run MacroName:="RepeatFind"
Wend
End With
Selection.HomeKey Unit:=wdStory
With Selection.Find
.Text = "^p "
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory
With Selection.Find
.Text = " ^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Текст макроса column02
Sub column02()
Dim lang As String
' Перед запуском необходимо выделить текст, который нужно преобразовать в таблицу
Set myRange = Selection.Range
With myRange
.Find.Execute FindText:="^p^p", ReplaceWith:="^p", Replace:=wdReplaceAll
.ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=1
lang = InputBox("Впечатай язык" & Chr(13) & "en" & Chr(13) & "fr" & Chr(13) & "de" & Chr(13) & "ru")
If lang = en Then .LanguageID = wdEnglishUK
If lang = fr Then .LanguageID = wdFrench
If lang = de Then .LanguageID = wdGerman
If lang = ru Then .LanguageID = wdRussian
End With
Selection.StartOf Unit:=wdColumn
Selection.InsertRowsAbove 1
Selection.SelectRow
Selection.Font.Bold = wdToggle
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Rows.HeadingFormat = True
Select Case lang
Case "en"
Selection.TypeText Text:="English"
Case "fr"
Selection.TypeText Text:="French"
Case "de"
Selection.TypeText Text:="Deutsch"
Case Else
Selection.TypeText Text:="Русский"
Selection.SelectColumn
Selection.InsertRowsBelow 20
End Select
Selection.SelectColumn
Selection.Columns.PreferredWidth = CentimetersToPoints(8)
Selection.EndOf (wdColumn)
End Sub
Текст макроса splitPara
Sub splitPara()
'
Dim col1 As Integer
Dim col2 As Integer
' splitPara Макрос
' Макрос создан 20.01.04 sokol
' Перед запуском макроса нужно поместить курсор не куда-нибудь,
' а перед тем предложением, где намечается новый абзац
' при этом пробел должон быть перед курсором, а курсор после пробела
Selection.Delete Unit:=wdCharacter, count:=-1
Selection.TypeParagraph
Selection.TypeParagraph
Selection.StartOf Unit:=wdRow
Selection.InsertRowsAbove 1
Selection.MoveDown Unit:=wdLine, count:=1
ActiveDocument.Bookmarks.Add Name:="arret"
Selection.MoveRight Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.Find.Execute FindText:="^p^p^?", Forward:=True, Wrap:=wdFindStop
If Selection.Find.Found() = True Then
Selection.StartOf Unit:=wdRow
Selection.MoveDown Unit:=wdParagraph, count:=2, Extend:=wdExtend
Selection.Cut
Selection.MoveUp Unit:=wdLine, count:=1
Selection.Paste
Selection.MoveRight Unit:=wdCell
ActiveDocument.Bookmarks.Add Name:="table"
Selection.MoveDown Unit:=wdLine, count:=1
Selection.EndOf Unit:=wdColumn, Extend:=wdExtend
Selection.Cut
Selection.GoTo What:=wdGoToBookmark, Name:="table"
Selection.Paste
Else
Selection.GoTo What:=wdGoToBookmark, Name:="arret"
Selection.MoveRight Unit:=wdCell
Selection.MoveLeft Unit:=wdCharacter, count:=1
Selection.MoveDown Unit:=wdParagraph, count:=2, Extend:=wdExtend
Selection.Cut
Selection.MoveUp Unit:=wdLine, count:=1
Selection.Paste
Selection.MoveLeft Unit:=wdCell
ActiveDocument.Bookmarks.Add Name:="table"
Selection.MoveDown Unit:=wdLine, count:=1
Selection.EndOf Unit:=wdColumn, Extend:=wdExtend
Selection.Cut
Selection.GoTo What:=wdGoToBookmark, Name:="table"
Selection.Paste
End If
Selection.EndOf Unit:=wdColumn
Selection.EndOf Unit:=wdRow
Selection.MoveLeft Unit:=wdCell
col1 = Asc(Selection.Text)
Selection.MoveRight Unit:=wdCell
col2 = Asc(Selection.Text)
If col1 = col2 And col1 = 13 Then
Selection.Rows.Delete
Selection.GoTo What:=wdGoToBookmark, Name:="arret"
Else
MsgBox ("А ТАМ ЧТО-ТО ЕСТЬ")
End If
End Sub
Текст макроса remove_tail
' Удаляет таблицу начиная с данной строки и до конца
' Перед запуском поставить курсор в начало строки, с которой производится удаление
Selection.SelectRow
Selection.EndKey Unit:=wdColumn, Extend:=wdExtend
Selection.Rows.Delete
End Sub
Текст макроса para
Sub Para()
'
' splitPara Макрос
' Макрос записан 06.04.04 sokol
' Ключ Ctrl+Alt+U
' разбив параграфа со значком +
Selection.TypeBackspace
Selection.TypeParagraph
Selection.MoveUp Unit:=wdParagraph, Extend:=wdExtend
Selection.Cut
col = Selection.Information(wdStartOfRangeColumnNumber)
Selection.InsertRowsAbove (1)
Select Case col
Case 1
Selection.MoveLeft
Selection.Paste
Selection.TypeBackspace
Selection.MoveDown (wdLine)
Selection.MoveRight (wdCell)
Selection.Find.Execute FindText:="+", Forward:=True, Wrap:=wdFindStop
Selection.TypeBackspace
Selection.TypeBackspace
Selection.TypeParagraph
Selection.MoveUp Unit:=wdParagraph, Extend:=wdExtend
Selection.Cut
Selection.MoveUp (wdLine)
Selection.Paste
Selection.TypeBackspace
Case Else
Selection.MoveLeft
Selection.MoveRight (wdCell)
Selection.Paste
Selection.TypeBackspace
Selection.MoveDown (wdLine)
Selection.MoveLeft (wdCell)
Selection.Find.Execute FindText:="+", Forward:=True, Wrap:=wdFindStop
Selection.TypeBackspace
Selection.TypeBackspace
Selection.TypeParagraph
Selection.MoveUp Unit:=wdParagraph, Extend:=wdExtend
Selection.Cut
Selection.MoveUp (wdLine)
Selection.Paste
Selection.TypeBackspace
End Select
End Sub
Текст макроса chapter01
Sub Chapter01()
'
' определям, сколько строк в заголовке
lines = InputBox("Сколько строк" & Chr(13) & "1" & Chr(13) & "2" & Chr(13) & "0, не выполнять макрос")
Select Case lines
Case "2"
' выделяем в отдельную таблицу заголовок
Selection.SplitTable
Selection.MoveDown
Selection.MoveRight (wdCell): Selection.MoveLeft (wdCell)
Selection.MoveRight
Selection.MoveDown
Selection.MoveRight (wdCell): Selection.MoveLeft (wdCell)
Selection.Cut
Selection.MoveUp
Selection.MoveRight (wdCell): Selection.MoveLeft (wdCell)
Selection.MoveRight
Selection.TypeText Text:=" "