Word Zoom

Problem

There are no keyboard shortcuts to zoom in/out with Word

Solution

Use a custom VBA procedures to zoom in/out

VBA code

Attribute VB_Name = "ModuleZoom"
Private Const ZoomStep As Integer = 5
Sub MyZoomAssignKeys()
 'Ron de Bruin, Disable key or key combination or run a macro if you use it
 'How do I use Application.Onkey
 'https://www.rondebruin.nl/win/s4/win012.htm
 'http://www.msofficeforums.com/excel-programming/14804-application-onkey-numeric-plus.html
 
 'Shift key = "+" (plus sign)
 'Ctrl key = "^" (caret)
 'Alt key = "%" (percent sign)
 
 CustomizationContext = NormalTemplate
 Application.StatusBar = "Assigning keys to MyZoom functions..."
 
 BindThisKey wdKeyControl, wdKeyNumericAdd, "Zoomin"
 BindThisKey wdKeyControl, wdKeyNumericSubtract, "ZoomOut"
 BindThisKey wdKeyControl, wdKeyNumeric0, "Zoom100"
 BindThisKey wdKeyControl, wdKeyNumeric1, "Zoom1page"
 BindThisKey wdKeyControl, wdKeyNumeric2, "Zoom2pages"
 BindThisKey wdKeyControl, wdKeyNumeric4, "Zoom4pages"
 
 Application.OnTime Now + TimeSerial(0, 0, 1), "MyZoomResetStatusbar"
 
End Sub
Sub BindThisKey(Key1 As Integer, Key2 As Integer, Action As String)
 KeyBindings.Add KeyCode:=BuildKeyCode(Key1, Key2), _
 KeyCategory:=wdKeyCategoryCommand, Command:=Action
 
End Sub




Sub MyZoomResetStatusbar()
 Application.StatusBar = False
End Sub
Sub ZoomInNew()
 Dim ZP As Integer
 ZP = Int(ActiveWindow.ActivePane.View.Zoom.Percentage * 1.1)
 If ZP > 200 Then ZP = 200
 ActiveWindow.ActivePane.View.Zoom.Percentage = ZP
End Sub
Sub ZoomIn()
'
' ZoomIn Macro
' Suggested shortcut: Ctrl + NumKeypad Plus
' Source: http://wordribbon.tips.net/T009831_Zooming_with_the_Keyboard.html
'
 Dim ZP As Integer
 ZP = ActiveWindow.ActivePane.View.Zoom.Percentage + ZoomStep
 ZP = Round(ZP / ZoomStep) * ZoomStep
 If ZP > 200 Then ZP = 200
 ActiveWindow.ActivePane.View.Zoom.Percentage = ZP
End Sub
Sub ZoomOut()
'
' ZoomOut Macro
' Suggested shortcut: Ctrl + NumKeypad Minus
' Source: http://wordribbon.tips.net/T009831_Zooming_with_the_Keyboard.html
'
 Dim ZP As Integer
 ZP = ActiveWindow.ActivePane.View.Zoom.Percentage - ZoomStep
 ZP = Round(ZP / ZoomStep) * ZoomStep
 If ZP < 10 Then ZP = 10
 ActiveWindow.ActivePane.View.Zoom.Percentage = ZP
End Sub
Sub ZoomReset()
'
' ZoooReset Macro
' Suggested shortcut: Ctrl + NumKeypad Zero
'
 ActiveWindow.ActivePane.View.Zoom.Percentage = 100
End Sub
Sub Zoom1page()
'
' Zoom1page Macro
' Suggested shortcut: Ctrl + NumKeypad 1
'
 'ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitFullPage
 On Error Resume Next
 If ActiveWindow.View.SplitSpecial = wdPaneNone Then
 ActiveWindow.ActivePane.View.Type = wdPrintView
 Else
 ActiveWindow.View.Type = wdPrintView
 End If

ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitFullPage
 
 With ActiveWindow.ActivePane.View.Zoom
 .PageColumns = 1
 .PageRows = 1
 End With
End Sub
Sub Zoom2pages()
'
' Zoom2pages Macro
' Suggested shortcut: Ctrl + NumKeypad 2
'
 'ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitNone
 With ActiveWindow.ActivePane.View.Zoom
 .PageColumns = 2
 .PageRows = 1
 End With
End Sub
Sub Zoom4pages()
'
' Zoom4pages Macro
' Suggested shortcut: Ctrl + NumKeypad 4
'
 'ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitNone
 With ActiveWindow.ActivePane.View.Zoom
 .PageColumns = 2
 .PageRows = 2
 End With
End Sub

Sub ZoomPageWidth()
'
' Zoom1page Macro
' Suggested shortcut: Ctrl + NumKeypad 1
'
 ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit
 
End Sub

 

Publicités

Excel VBA

Articles

Trust center settings

Personal.xlsb