There is another thread in this forum where the discussion has turned to vertically centering a selected range in the active window. The code presented is shown below:
Sub SelectionScrollIntoMiddleOfView()'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.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
My experience here is that code simply doesn't work. First, it doesn't compile because of the "Direction, down" in the ActiveWindow.Smallscroll line. Remove ", down" from that line and it will compile but when run with the condition shown in image "1" nothing happens.
Macropod suggested two simple lines of code:
ActiveWindow.LargeScroll Down:=1
ActiveWindow.ScrollIntoView Selection.Range
However, when that is run on the condition one text the result is as shown in image "Paul Simple Method" (note the selected text
is at the top of the window (not centered in the window)
The goal is for the text to appear more like the text in image "Goal"
1.jpgImage 1
Paul simple method.jpgPaul Simple Method (result after running)
Goal.jpgGoal
Iv'e been struggling with deducing the center of the selection as compared to the center of the useable
window and moving the selection up or down as appropriate. The following gets close with the examples shown but if the selection is just a single line
of text then it ends up being a little above or below center:
Sub SelectionScrollIntoMiddleOfView()
Dim lngLeft As Long, lngTop As Long, lngWidth As Long, lngHeight As Long, lngComp As Long
Dim lngWinTop As Long, lngWinHgt As Long, lngWinUseableHgt As Long
Dim lngScroll As Integer
Dim lngCenter As Long, lngWinCenter As Long
Dim lngCounter As Long
lngWinHgt = PixelsToPoints(ActiveWindow.Height, True)
lngWinUseableHgt = PixelsToPoints(ActiveWindow.UsableHeight, True)
lngComp = lngWinHgt - lngWinUseableHgt
lngWinTop = PixelsToPoints(ActiveWindow.Top, True)
lngWinCenter = (lngWinTop + lngWinHgt) / 2
ActiveWindow.ScrollIntoView Selection.Range
ActiveWindow.GetPoint lngLeft, lngTop, lngWidth, lngHeight, Selection.Range
lngCenter = ((lngTop - lngComp) + lngHeight) / 2
lngScroll = Sgn(lngCenter - lngWinCenter)
Do
ActiveWindow.SmallScroll lngScroll
lngCounter = lngCounter + 1
ActiveWindow.GetPoint lngLeft, lngTop, lngWidth, lngHeight, Selection.Range
lngCenter = ((lngTop - lngComp) + lngHeight) / 2
If lngScroll > 0 Then
If lngCenter > lngWinCenter Then
If lngCenter - lngWinCenter < 10 Then Exit Do
Else
If lngWinCenter - lngCenter < 10 Then Exit Do
End If
Else
If lngCenter > lngWinCenter Then
If lngCenter - lngWinCenter > 10 Then Exit Do
Else
If lngWinCenter - lngCenter < 10 Then Exit Do
End If
End If
If lngCounter > 20 Then Exit Do
Loop
lbl_Exit:
Exit Sub
End Sub
Interested if anyone has ideas to improve this process. Paul, I understand the concerns you raised about centering and message boxes.
This is not related to displaying a message box. Just a process of trying to do something that should be able to be done ;-)