#1
|
|||
|
|||
Vertically Center Selected Range in the Useable Window
Any regulars here want to take a stab at this see:
Vertically Center Selected Range in the Useable ActiveWindow There is some code floating about published by Andreas Killer about 10 years ago for centering selected text in the active window: Code:
Sub SelectionScrollIntoMiddleOfView3() 'https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-msoffice_custom-mso_2010/centre-selected-text-in-the-middle-of-the-screen/84ab25fe-9570-4b55-91bd-4b11a04bb99b?auth=1 Dim pLeft As Long Dim pTop As Long, lTop As Long, wTop As Long Dim pWidth As Long Dim pHeight As Long, wHeight As Long Dim Direction As Integer wHeight = PixelsToPoints(ActiveWindow.Height, True) ActiveWindow.GetPoint pLeft, wTop, pWidth, pHeight, ActiveWindow ActiveWindow.ScrollIntoView Selection.Range ActiveWindow.GetPoint pLeft, pTop, pWidth, pHeight, Selection.Range Direction = Sgn((pTop + pHeight / 2) - (wTop + wHeight / 2)) Do While Sgn((pTop + pHeight / 2) - (wTop + wHeight / 2)) = Direction And (lTop <> pTop) ActiveWindow.SmallScroll Direction, down On Error Resume Next lTop = pTop ActiveWindow.GetPoint pLeft, pTop, pWidth, pHeight, Selection.Range Loop End Sub I've put some example images in the linked thread and I've managed to put this together which (for me) works better, but there is an unresolved issue if the selected text spans more than one line. For me (and on my PC and ActiveWindow), one line of selected text returns a value of 28 and I can tweak the centering to using that value. That may not work for everyone. Can't figure out how to nail the center of the selected text to the center of the active window. All suggestions welcome!! Code:
Sub SelectionScrollIntoMiddleOfView() Dim lngLeft As Long, lngTop As Long, lngWidth As Long, lngHeight As Long Dim lngWinTop As Long, lngWinUseableHgt As Long Dim lngScroll As Integer Dim lngCenter As Long, lngWinCenter As Long Dim lngCenAdj As Long, lngIndex As Long '*** lngWinUseableHgt = ActiveWindow.UsableHeight lngWinTop = ActiveWindow.Top lngWinCenter = (lngWinTop + lngWinUseableHgt + 1) / 2 ActiveWindow.ScrollIntoView Selection.Range ActiveWindow.GetPoint lngLeft, lngTop, lngWidth, lngHeight, Selection.Range lngCenter = (lngTop + lngHeight) / 2 lngScroll = Sgn(lngCenter - lngWinCenter) lngCenAdj = ((lngHeight / 28) - 1) / 2 '*** On my screen, a slection of one line returns 28 Do Until Abs(lngCenter - lngWinCenter) < 10 ActiveWindow.SmallScroll lngScroll ActiveWindow.GetPoint lngLeft, lngTop, lngWidth, lngHeight, Selection.Range lngCenter = (lngTop + lngHeight) / 2 Loop '*** Adjust center based on height of selection If lngCenAdj > 0 Then For lngIndex = 1 To lngCenAdj If lngScroll = 1 Then ActiveWindow.SmallScroll -1 If lngScroll = -1 Then ActiveWindow.SmallScroll -1 Next lngIndex End If lbl_Exit: Exit Sub End Sub |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to center text vertically in rectangle/ textbox | alexcalgary | Word | 3 | 11-26-2021 10:57 AM |
How to vertically center text in a line | SPO | Word | 4 | 01-18-2017 02:48 PM |
Unable to vertically center align texts in table cells? | tinfanide | Word | 3 | 11-24-2013 06:37 AM |
How to Center One Line Vertically on Blank Page | SQLUSA | Word | 1 | 08-29-2012 08:14 PM |
How vertically center text with enlarged bullet? | judithvg | PowerPoint | 2 | 05-09-2012 02:18 AM |