Option Explicit
Sub ToggleNoSingleDoubleStrikenThrough()
If (Selection.Range.Font.DoubleStrikeThrough) Then
Selection.Range.Font.DoubleStrikeThrough = False
Selection.Range.Font.StrikeThrough = False
ElseIf (Selection.Range.Font.StrikeThrough) Then
Selection.Range.Font.DoubleStrikeThrough = True
Else
Selection.Range.Font.StrikeThrough = True
End If
End Sub
Private Sub SetColor(color As WdColor)
Selection.Font.color = color
End Sub
Sub SetColorAutomatic()
SetColor (wdColorAutomatic)
End Sub
Sub SetColorBlue()
SetColor (wdColorBlue)
End Sub
Sub SetColorGreen()
SetColor (wdColorSeaGreen)
End Sub
Sub SetColorRed()
SetColor (wdColorRed)
End Sub
Private Sub SetHighlight(high As WdColor)
Selection.Range.HighlightColorIndex = high
End Sub
Sub HighlightNone()
SetHighlight (wdNoHighlight)
End Sub
Sub HighlightRed()
SetHighlight (wdRed)
End Sub
Sub HighlightYellow()
SetHighlight (wdYellow)
End Sub
Sub HighlightGreen()
SetHighlight (wdBrightGreen)
End Sub
Sub HighlightBlue()
SetHighlight (wdTurquoise)
End Sub
Sub HighlightPurple()
SetHighlight (wdPink)
End Sub
Sub SetLanguageToFrench()
Selection.LanguageID = wdFrench
End Sub
Sub SetLanguageToEnglish()
Selection.LanguageID = wdEnglishUS
End Sub
Sub SwitchProofing()
Selection.NoProofing = Not Selection.NoProofing
End Sub
Sub InsertCurrentTime()
Selection.InsertDateTime DateTimeFormat:="HH:mm", DateLanguage:=Selection.LanguageID, InsertAsField:=False
End Sub
Sub InsertCurrentDate()
Selection.InsertDateTime DateTimeFormat:="dddd d MMMM yyyy", DateLanguage:=Selection.LanguageID, InsertAsField:=False
End Sub
Sub InsertCurrentDate8601()
Selection.InsertDateTime DateTimeFormat:="yyyy-MM-dd", DateLanguage:=Selection.LanguageID, InsertAsField:=False
End Sub
Sub SimplePaste()
Selection.PasteAndFormat (wdFormatPlainText)
End Sub
Sub FullScreenPrintPreview()
ActiveDocument.PrintPreview
ActiveDocument.ActiveWindow.View.FullScreen = True
End Sub
Sub ClearTabs()
Selection.ParagraphFormat.TabStops.ClearAll
End Sub
Sub DisplayRuler()
ActiveDocument.ActiveWindow.ActivePane.DisplayRulers = Not ActiveDocument.ActiveWindow.ActivePane.DisplayRulers
End Sub
Sub SplitUnsplit()
If ActiveDocument.ActiveWindow.Split Then
ActiveDocument.ActiveWindow.Panes(3 - ActiveDocument.ActiveWindow.ActivePane.Index).Close
Else
ActiveDocument.ActiveWindow.Split = True
End If
End Sub
Sub DisplayMap()
ActiveDocument.ActiveWindow.DocumentMap = Not ActiveDocument.ActiveWindow.DocumentMap
End Sub
Sub DisplayFormatting()
Application.TaskPanes(wdTaskPaneFormatting).Visible = True
ActiveDocument.FormattingShowClear = False
ActiveDocument.FormattingShowFilter = wdShowFilterFormattingInUse
ActiveDocument.FormattingShowFont = True
ActiveDocument.FormattingShowNumbering = True
ActiveDocument.FormattingShowParagraph = True
End Sub
Sub DisplayRevealFormatting()
Application.TaskPanes(wdTaskPaneRevealFormatting).Visible = True
End Sub
Sub ViewAsNormal()
Dim b As Boolean
b = ActiveDocument.ActiveWindow.DocumentMap
ActiveDocument.ActiveWindow.View.Type = wdNormalView
ActiveDocument.ActiveWindow.DocumentMap = b
Application.DisplayStatusBar = True
ActiveDocument.ActiveWindow.DisplayHorizontalScrollBar = True
ActiveDocument.ActiveWindow.DisplayVerticalScrollBar = True
End Sub
Sub ViewAsPage()
Dim b As Boolean
b = ActiveDocument.ActiveWindow.DocumentMap
ActiveDocument.ActiveWindow.View.Type = wdPageView
ActiveDocument.ActiveWindow.DocumentMap = b
ActiveDocument.ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitFullPage
Application.DisplayStatusBar = True
ActiveDocument.ActiveWindow.DisplayHorizontalScrollBar = True
ActiveDocument.ActiveWindow.DisplayVerticalScrollBar = True
ActiveDocument.ActiveWindow.View.DisplayPageBoundaries = True
End Sub
Sub ViewAsOutline()
Dim b As Boolean
b = ActiveDocument.ActiveWindow.DocumentMap
ActiveDocument.ActiveWindow.View.Type = wdOutlineView
ActiveDocument.ActiveWindow.DocumentMap = b
Application.DisplayStatusBar = True
ActiveDocument.ActiveWindow.DisplayHorizontalScrollBar = True
ActiveDocument.ActiveWindow.DisplayVerticalScrollBar = True
End Sub
Sub ViewAsWeb()
Dim b As Boolean
b = ActiveDocument.ActiveWindow.DocumentMap
ActiveDocument.ActiveWindow.View.Type = wdWebView
ActiveDocument.ActiveWindow.DocumentMap = b
Application.DisplayStatusBar = True
ActiveDocument.ActiveWindow.DisplayHorizontalScrollBar = True
ActiveDocument.ActiveWindow.DisplayVerticalScrollBar = True
End Sub
Sub ViewAsReading()
Dim b As Boolean
b = ActiveDocument.ActiveWindow.DocumentMap
ActiveDocument.ActiveWindow.View.ReadingLayout = True
ActiveDocument.ActiveWindow.DocumentMap = b
End Sub
Sub ViewAsReview()
ActiveDocument.ActiveWindow.View.ShowRevisionsAndComments = True
ActiveDocument.ActiveWindow.View.RevisionsView = wdRevisionsViewFinal
ActiveDocument.ActiveWindow.View.ShowInkAnnotations = False
ActiveDocument.ActiveWindow.View.ShowInsertionsAndDeletions = False
ActiveDocument.ActiveWindow.View.ShowFormatChanges = False
ActiveDocument.ActiveWindow.ToggleShowAllReviewers
ActiveDocument.ActiveWindow.View.Reviewers(Application.UserName).Visible = True
End Sub
Sub SwitchBorders()
If ((Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone) Or _
(Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone) Or _
(Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone) Or _
(Selection.Borders(wdBorderRight).LineStyle = wdLineStyleNone)) Then
Selection.Borders(wdBorderTop).LineStyle = Options.DefaultBorderLineStyle
Selection.Borders(wdBorderLeft).LineStyle = Options.DefaultBorderLineStyle
Selection.Borders(wdBorderBottom).LineStyle = Options.DefaultBorderLineStyle
Selection.Borders(wdBorderRight).LineStyle = Options.DefaultBorderLineStyle
Else
Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderRight).LineStyle = wdLineStyleNone
End If
End Sub
Sub InsertCommentInCurrentPlace()
If (Selection.range.End = Selection.range.Start) Then
Selection.TypeText text:=" "
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Comments.Add range:=Selection.range
Else
Selection.Comments.Add range:=Selection.range
End If
End Sub
Sub ExpandDocument()
ActiveDocument.Subdocuments.Expanded = Not ActiveDocument.Subdocuments.Expanded
End Sub
Sub Text2XML()
Dim replacement As String
Dim theStart, theEnd As Long
Dim avance As Long
Dim rg As range
Dim i As Integer
theStart = Selection.Start
theEnd = Selection.End
Do While theStart < theEnd
Set rg = ActiveDocument.range(theStart, theStart + 1)
If (rg.text <> "") Then ' text may be empty (e.g. if the range contains a hyperlink)
i = AscW(rg.text)
If (i = 38) Then
replacement = "&"
ElseIf (i = 60) Then
replacement = "<"
ElseIf (i = 62) Then
replacement = ">"
ElseIf (i > 31 And i < 127) Or i = 13 Or i = 10 Then
replacement = rg.text
Else
replacement = "&#x" & Hex(i) & ";"
End If
rg.text = replacement
avance = Len(replacement)
Else
avance = 1
End If
theStart = theStart + avance
theEnd = theEnd + avance - 1
Loop
End Sub
Sub CleanFileHistory()
Application.DisplayRecentFiles = False
Application.DisplayRecentFiles = True
RecentFiles.Maximum = 9
End Sub
Sub Customize()
CustomizationContext = NormalTemplate
' --------------- paragraph format
' Ctrl+R => paragraph on the right
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyR, wdKeyControl), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="RightPara"
' Ctrl+L => paragraph on the left
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyL, wdKeyControl), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="LeftPara"
' Ctrl+E => paragraph at the center
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyE, wdKeyControl), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="CenterPara"
' Ctrl+M => indent
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyM, wdKeyControl), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="Indent"
' Shift+Ctrl+M => unindent
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyM, wdKeyControl, wdKeyShift), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="UnIndent"
' Alt+Z => remove the tabs
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyZ, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="ClearTabs"
' Alt+B => bullet
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyB, wdKeyAlt), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="FormatBulletDefault"
' Alt+E => add/remove paragraph borders
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyE, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="SwitchBorders"
' --------------- table
' Ctrl+Numeric* => merge cells
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyNumericMultiply, wdKeyControl), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="TableMergeCells"
' Ctrl+Numeric/ => delete column
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyNumericDivide, wdKeyControl), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="TableDeleteColumn"
' Ctrl+Shift+Numeric/ => delete line
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyNumericDivide, wdKeyControl, wdKeyShift), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="TableDeleteRow"
' --------------- color
' Ctrl+1,Shift+N => no color
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey1, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyN, wdKeyShift), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="SetColorAutomatic"
' Ctrl+1,Shift+B => blue
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey1, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyB, wdKeyShift), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="SetColorBlue"
' Ctrl+1,Shift+B => green
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey1, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyG, wdKeyShift), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="SetColorGreen"
' Ctrl+1,Shift+R => red
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey1, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyR, wdKeyShift), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="SetColorRed"
' --------------- highlight
' Ctrl+1,N => no highlight
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey1, wdKeyControl), KeyCode2:=wdKeyN, _
KeyCategory:=wdKeyCategoryMacro, _
Command:="HighlightNone"
' Ctrl+1,B => blue highlight
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey1, wdKeyControl), KeyCode2:=wdKeyB, _
KeyCategory:=wdKeyCategoryMacro, _
Command:="HighlightBlue"
' Ctrl+1,G => green highlight
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey1, wdKeyControl), KeyCode2:=wdKeyG, _
KeyCategory:=wdKeyCategoryMacro, _
Command:="HighlightGreen"
' Ctrl+1,P => purple highlight
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey1, wdKeyControl), KeyCode2:=wdKeyP, _
KeyCategory:=wdKeyCategoryMacro, _
Command:="HighlightPurple"
' Ctrl+1,R => red highlight
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey1, wdKeyControl), KeyCode2:=wdKeyR, _
KeyCategory:=wdKeyCategoryMacro, _
Command:="HighlightRed"
' Ctrl+1,Y => yellow highlight
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey1, wdKeyControl), KeyCode2:=wdKeyY, _
KeyCategory:=wdKeyCategoryMacro, _
Command:="HighlightYellow"
' --------------- character format
' Ctrl+B => bold
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyB, wdKeyControl), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="Bold"
' Alt+C => replace character by its code
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyC, wdKeyAlt), _
KeyCategory:= wdKeyCategoryCommand, _
Command:="ToggleCharacterCode"
' Ctrl+! => striken
KeyBindings.Add KeyCode:=BuildKeyCode(223, wdKeyControl), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="ToggleNoSingleDoubleStrikenThrough"
' Shift+Ctrl+! => hidden
KeyBindings.Add KeyCode:=BuildKeyCode(223, wdKeyControl, wdKeyShift), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="Hidden"
' --------------- dates
' Shift+Alt+T => insert current time
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyT, wdKeyShift, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="InsertCurrentTime"
' Alt+D => insert current date
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyD, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="InsertCurrentDate"
' Shift+Alt+D => insert current date with ISO 8601 format
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyD, wdKeyShift, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="InsertCurrentDate8601"
' --------------- cut 'n paste
' Alt+, => paste as unformatted text
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyComma, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="SimplePaste"
' Shift+Ctrl+, => special paste
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyComma, wdKeyControl, wdKeyShift), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="EditPasteSpecial"
' Shift+Ctrl+C => copy format
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyC, wdKeyControl, wdKeyShift), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="CopyFormat"
' Shift+Ctrl+V => paste format
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyV, wdKeyControl, wdKeyShift), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="PasteFormat"
' --------------- display
' Ctrl+Alt+N => switch to normal mode
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyN, wdKeyControl, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="ViewAsNormal"
' Ctrl+Alt+P => switch to page mode
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyP, wdKeyControl, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="ViewAsPage"
' Ctrl+Alt+O => switch to outline mode
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyO, wdKeyControl, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="ViewAsOutline"
' Ctrl+Alt+L => switch to reading mode
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyL, wdKeyControl, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="ViewAsReading"
' Ctrl+Alt+W => switch to Web mode
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyW, wdKeyControl, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="ViewAsWeb"
' Ctrl+Alt+R => set in a mode ready for review
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyR, wdKeyControl, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="ViewAsReview"
' Alt+Shift+S => split/unsplit the window
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyS, wdKeyShift, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="SplitUnsplit"
' Alt+Q => display header
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyQ, wdKeyAlt), KeyCategory:= _
wdKeyCategoryCommand, _
Command:="NormalViewHeaderArea"
' Ctrl+* => display/undisplay all special characters
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyBackSlash, wdKeyControl), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="ShowAll"
' Alt+N => display/undisplay the ruler
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyN, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="DisplayRuler"
' Alt+O => display/undisplay the document map
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyO, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="DisplayMap"
' Alt+S => display the current style
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyS, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="DisplayFormatting"
' Alt+F => display the current format
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyF, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="DisplayRevealFormatting"
' Alt+P => display the print preview
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyP, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="FullScreenPrintPreview"
' --------------- comments
' Alt+W => insert new comment on current selection
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyW, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="InsertCommentInCurrentPlace"
' --------------- bookmarks
' Alt+K => display cross-reference windows
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyK, wdKeyAlt), _
KeyCategory:= wdKeyCategoryCommand, _
Command:="InsertCrossReference"
' Alt+I => display bookmark window
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyI, wdKeyAlt), _
KeyCategory:= wdKeyCategoryCommand, _
Command:="EditBookmark"
' --------------- language
' Shift+Ctrl+Alt+E => flag text as English
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyE, wdKeyControl, wdKeyShift, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="SetLanguageToEnglish"
' Shift+Ctrl+Alt+F => flag text as French
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyF, wdKeyControl, wdKeyShift, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="SetLanguageToFrench"
' Shift+Ctrl+Alt+O => flag text as non proofable
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyO, wdKeyControl, wdKeyShift, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="SwitchProofing"
' --------------- insert characters
' Ctrl+4, Left => insert left arrow
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey4, wdKeyControl), KeyCode2:=BuildKeyCode(37), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(8592)
' Ctrl+4, Up => insert up arrow
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey4, wdKeyControl), KeyCode2:=BuildKeyCode(38), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(8593)
' Ctrl+4, Right => insert right arrow
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey4, wdKeyControl), KeyCode2:=BuildKeyCode(39), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(8594)
' Ctrl+4, Bottom => insert down arrow
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey4, wdKeyControl), KeyCode2:=BuildKeyCode(40), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(8595)
' Ctrl+4, Shift+Left => insert left/right arrow
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey4, wdKeyControl), KeyCode2:=BuildKeyCode(37, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(8596)
' Ctrl+4, Shift+Up => insert up/down arrow
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey4, wdKeyControl), KeyCode2:=BuildKeyCode(38, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(8597)
' Ctrl+4, < => less or equal
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey4, wdKeyControl), KeyCode2:=BuildKeyCode(226), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(8804)
' Ctrl+4, Shift+< => greater or equal
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey4, wdKeyControl), KeyCode2:=BuildKeyCode(226, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(8805)
' Ctrl+4, L => insert a horizontal line
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey4, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyL), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="InsertHorizontalLine"
' Ctrl+2, A => insert a lower alpha character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyA), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(945)
' Ctrl+2, B => insert a lower beta character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyB), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(946)
' Ctrl+2, C => insert a lower gamma character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyC), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(947)
' Ctrl+2, D => insert a lower delta character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyD), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(948)
' Ctrl+2, E => insert a lower epsilon character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyE), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(949)
' Ctrl+2, K => insert a lower kappa character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyK), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(954)
' Ctrl+2, L => insert a lower lambda character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyL), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(955)
' Ctrl+2, M => insert a lower mu character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyM), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(956)
' Ctrl+2, N => insert a lower nu character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyN), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(957)
' Ctrl+2, O => insert a lower omega character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyO), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(969)
' Ctrl+2, P => insert a lower pi character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyP), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(960)
' Ctrl+2, R => insert a lower rho character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyR), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(961)
' Ctrl+2, S => insert a lower sigma character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyS), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(963)
' Ctrl+2, Shift+A => insert an upper alpha character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyA, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(913)
' Ctrl+2, Shift+B => insert an upper beta character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyB, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(914)
' Ctrl+2, Shift+C => insert an upper gamma character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyC, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(915)
' Ctrl+2, Shift+D => insert an upper delta character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyD, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(916)
' Ctrl+2, Shift+E => insert an upper epsilon character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyE, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(917)
' Ctrl+2, Shift+K => insert an upper kappa character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyK, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(922)
' Ctrl+2, Shift+L => insert an upper lambda character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyL, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(923)
' Ctrl+2, Shift+M => insert an upper mu character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyM, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(924)
' Ctrl+2, Shift+N => insert an upper nu character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyN, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(925)
' Ctrl+2, Shift+O => insert an upper omega character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyO, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(937)
' Ctrl+2, Shift+P => insert an upper pi character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyP, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(928)
' Ctrl+2, Shift+R => insert an upper rho character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyR, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(929)
' Ctrl+2, Shift+S => insert an upper sigma character
KeyBindings.Add KeyCode:=BuildKeyCode(wdKey2, wdKeyControl), KeyCode2:=BuildKeyCode(wdKeyS, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(&H3A3)
' Ctrl+Numeric- => insert en-dash
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyNumericSubtract, wdKeyControl), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(&H2013)
' Ctrl+Shift+Numeric- => insert em-dash
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyNumericSubtract, wdKeyControl, wdKeyShift), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(&H2014)
' Ctrl+Numeric- => insert ellipsis
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyNumericDecimal, wdKeyControl), _
KeyCategory:=wdKeyCategorySymbol, _
Command:=ChrW(&H2026)
' --------------- miscellaneous
' Ctrl+G => edit goto
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyG, wdKeyControl), _
KeyCategory:= wdKeyCategoryCommand, _
Command:="EditGoTo"
' Alt+Numeric- => clean file history
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyNumericSubtract, wdKeyAlt), _
KeyCategory:=wdKeyCategoryMacro, _
Command:="CleanFileHistory"
' configure the menubar display
CommandBars.DisplayTooltips = True
CommandBars.DisplayKeysInTooltips = True
CommandBars.AdaptiveMenus = False
CommandBars("Web").Enabled = False
' use a single window
Application.ShowWindowsInTaskbar = False
' record the last nine used files
RecentFiles.Maximum = 9
' check the file properties the first time it is saved
Options.SavePropertiesPrompt = True
' always display the fields as shaded
Application.ActiveWindow.View.FieldShading = wdFieldShadingAlways
' always ask for how the file should be loaded
Options.ConfirmConversions = True
' display the bookmarks
Application.ActiveWindow.View.ShowBookmarks = True
' set the autocorrection entries
Dim entry As AutoCorrectEntry
For Each entry In AutoCorrect.Entries
entry.Delete
Next entry
AutoCorrect.Entries.Add Name:="²co", Value:="Cordialement," & vbCr & "Laurent"
AutoCorrect.Entries.Add Name:="²ca", Value:="Regards," & vbCr & "Laurent"
AutoCorrect.ReplaceText = True
' avoid the other autocorrections
AutoCorrect.CorrectInitialCaps = False
AutoCorrect.CorrectSentenceCaps = False
AutoCorrect.CorrectDays = False
AutoCorrect.CorrectCapsLock = False
AutoCorrect.ReplaceTextFromSpellingChecker = False
AutoCorrect.CorrectKeyboardSetting = False
AutoCorrect.DisplayAutoCorrectOptions = False
AutoCorrect.CorrectTableCells = False
Options.AutoFormatAsYouTypeApplyHeadings = False
Options.AutoFormatAsYouTypeApplyBorders = False
Options.AutoFormatAsYouTypeApplyBulletedLists = False
Options.AutoFormatAsYouTypeApplyNumberedLists = False
Options.AutoFormatAsYouTypeApplyTables = False
Options.AutoFormatAsYouTypeReplaceQuotes = False
Options.AutoFormatAsYouTypeReplaceSymbols = False
Options.AutoFormatAsYouTypeReplaceOrdinals = False
Options.AutoFormatAsYouTypeReplaceFractions = False
Options.AutoFormatAsYouTypeReplacePlainTextEmphasis = False
Options.AutoFormatAsYouTypeReplaceHyperlinks = False
Options.AutoFormatAsYouTypeFormatListItemBeginning = False
Options.AutoFormatAsYouTypeDefineStyles = False
Options.TabIndentKey = False
Options.AutoFormatApplyHeadings = False
Options.AutoFormatApplyLists = False
Options.AutoFormatApplyBulletedLists = False
Options.AutoFormatApplyOtherParas = False
Options.AutoFormatReplaceQuotes = False
Options.AutoFormatReplaceSymbols = False
Options.AutoFormatReplaceOrdinals = False
Options.AutoFormatReplaceFractions = False
Options.AutoFormatReplacePlainTextEmphasis = False
Options.AutoFormatReplaceHyperlinks = False
Options.AutoFormatPreserveStyles = False
Options.AutoFormatPlainTextWordMail = False
Options.LabelSmartTags = False
Options.DisplaySmartTagButtons = False
Options.AllowAccentedUppercase = True
Application.DisplayAutoCompleteTips = False
' define the user
Application.UserName = "Laurent Mazuré"
Application.UserInitials = "LM"
Application.UserAddress = ""
End Sub
Sub SaveXML()
Dim p As Paragraph
Set p = ActiveDocument.Paragraphs(6)
If ((Left(p.range.text, 6) <> "<DATE>") Or _
((Right(p.range.text, 9) <> ("</DATE>" & vbCrLf)) And (Right(p.range.text, 8) <> ("</DATE>" & vbCr)))) Then
MsgBox "Incorrect date (" & p.range.text & ")", vbOKOnly
Exit Sub
End If
p.Range.Text = "<DATE><YEAR>" & Year(Now) & "</YEAR><MONTH>" & Month(Now) & "</MONTH><DAY>" & Day(Now) & "</DAY></DATE>" & vbCrLf
ActiveDocument.Save
End Sub
|