Const
TName =
"CrackNoteTool"
Sub
AutoExec()
With
Application.CommandBars.Add(Name:=TName, _
Position:=msoBarTop, Temporary:=
True
)
.Visible =
True
With
.Controls.Add(Type:=msoControlButton, ID _
:=1, Before:=1, Temporary:=
True
)
.BeginGroup =
False
.OnAction =
"Page_Setup"
.FaceId = 501
.Caption =
"Page setup"
End
With
With
.Controls.Add(Type:=msoControlButton, ID _
:=1, Before:=1, Temporary:=
True
)
.BeginGroup =
False
.OnAction =
"Align_Columns"
.FaceId = 269
.Caption =
"Align columns"
End
With
End
With
End
Sub
Sub
AutoExit()
CommandBars(TName).Delete
End
Sub
Sub
Page_Setup()
With
ActiveDocument.PageSetup
.TopMargin = CentimetersToPoints(1)
.BottomMargin = CentimetersToPoints(1)
.LeftMargin = CentimetersToPoints(1)
.RightMargin = CentimetersToPoints(1)
End
With
End
Sub
Sub
Align_Columns()
Dim
s
As
String
, tmp
As
String
Dim
iStart
As
Long
, iEnd
As
Long
, pos
As
Long
, i
As
Long
Dim
reg
As
New
RegExp
Dim
m
As
MatchCollection
Const
COL1 = 91.5, COL2 = 175.5, COL3 = 345.5
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
While
Right(Selection, 1) = vbCr
Or
Right(Selection, 1) = vbLf
Selection.
End
= Selection.
End
- 1
Wend
iStart = Selection.Start
Selection.MoveRight unit:=wdCharacter, Count:=1
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:=
"endSelection"
Selection.HomeKey unit:=wdStory
Selection.MoveRight unit:=wdCharacter, Count:=iStart
While
Selection.Start < ActiveDocument.Bookmarks(
"endSelection"
).Start
Selection.MoveRight unit:=wdWord, Extend:=1
Selection = Trim(Selection)
Selection.MoveRight unit:=wdCharacter, Count:=1
Selection = vbTab
Selection.MoveRight unit:=wdCharacter, Count:=1
Selection.EndKey unit:=wdLine, Extend:=wdExtend
s = Selection
reg.Pattern =
"[a-z]{2,}\s?"
Set
m = reg.Execute(s)
tmp = m.Item(0).Value
pos = InStr(s, tmp) - 1
Selection.
End
= Selection.Start + pos
Selection = Trim(Selection)
Selection.MoveRight unit:=wdCharacter, Count:=1
If
Selection.Information(wdHorizontalPositionRelativeToPage) >= COL2
Then
Selection =
" "
Selection.MoveRight unit:=wdCharacter, Count:=1
Else
While
Selection.Information(wdHorizontalPositionRelativeToPage) < COL2
Selection = vbTab
Selection.MoveRight unit:=wdCharacter, Count:=1
Wend
End
If
Selection.EndKey unit:=wdLine, Extend:=wdExtend
s = Selection
pos = InStr(s,
";"
)
If
pos = 0
Then
Selection.MoveRight unit:=wdCharacter, Count:=1
Else
Selection.
End
= Selection.Start + pos - 1
Selection = Trim(Selection)
Selection.MoveRight unit:=wdCharacter, Count:=1
If
Selection.Information(wdHorizontalPositionRelativeToPage) >= COL3
Then
Selection =
" "
Selection.MoveRight unit:=wdCharacter, Count:=1
Else
While
Selection.Information(wdHorizontalPositionRelativeToPage) < COL3
Selection = vbTab
Selection.MoveRight unit:=wdCharacter, Count:=1
Wend
End
If
Selection.EndKey unit:=wdLine, Extend:=wdExtend
s = Selection
If
Right(s, 1) = vbCr
Then
Selection.MoveRight unit:=wdCharacter, Count:=1
Else
Selection.MoveRight unit:=wdCharacter, Count:=1
Selection.EndKey unit:=wdLine, Extend:=wdExtend
Selection.MoveRight unit:=wdCharacter, Count:=1
End
If
End
If
Wend
ActiveDocument.Bookmarks(
"endSelection"
).Delete
End
Sub