I have a UserForm of a MonthView that opens when I click in the specified range of cells. This SO thread gave me the basic script. It doesn't put the UserForm where I expect.
Here is the script (that I placed in a specific worksheet) to open the UserForm when I click any cell in range B3:C2000
.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set oRange = Range("B3:C2000")
If Not Intersect(Target, oRange) Is Nothing Then
frmCalendar.Show
frmCalendar.Top = ActiveCell.Offset(0, 0).Top
frmCalendar.Left = ActiveCell.Offset(0, 1).Left
End If
End Sub
Question 1: I have the UserForm StartUpPosition property set to 0 - Manual
- is this correct?
Question 2: When I click any cell in the specified range, for the first time after opening the workbook, the UserForm always opens in the far top left corner of the screen. Why?
Question 3: When I click any cell in the specified range, for any clicks after the first, the UserForm opens relative to the previous cell that was active, instead of the one I just clicked. How do I get it to open relative to the cell just clicked, instead of relative to the previous active cell?
Question 4: Why does it appear to align the bottom of the UserForm instead of the top?
After I do the following steps:
1 - Click cell C15
2 - UserForm opens
3 - Close UserForm
4 - Click cell 16
5 - UserForm opens
This is what I see:
EDIT: Here is the result after implementing J. Garth's solution (and changing the Offset property to (0, 2):
Create a new Userform and press F5 to display it. The default position for the Userform should be in the center of the Office application. When the user only has one monitor, this is fine. However if the user has multiple screens you might find the Userform is not displayed in the center.
In order to draw a line on a Userform you take a pen and you simply draw a line on the the Userform <g>. The following user-form module shows a "fun" example of how you can do that. Insert a new Userform with no controls on it.
How to Close UserForm in Excel VBA? Once the purpose of the user form is done, there is a point in keep showing the userform in front of the user, so we need to close the userform. We can close the userform by using the “Unload Me” statement and “UserForm. Hide” statements.
Question 1: I have the UserForm StartUpPosition property set to 0 - Manual - is this correct? Yes, it's correct. In the code below, I am setting this property in the code.
Question 2: When I click any cell in the specified range, for the first time after opening the workbook, the UserForm always opens in the far top left corner of the screen. Why? I think the answer to this is somewhat related to question #3. That would seem to be a default location for the form to open in. The way you have the code now, trying to set the form top and left coordinates in the Worksheet_SelectionChange
event is not working because the coordinates are never actually getting set. The setting of the coordinates needs to be moved to the userform initialization event.
Question 3: When I click any cell in the specified range, for any clicks after the first, the UserForm opens relative to the previous cell that was active, instead of the one I just clicked. How do I get it to open relative to the cell just clicked, instead of relative to the previous active cell? This problem is also related to the code being in the wrong place. As noted above, the coordination setting needs to take place in the userform initialization event. As to why it's referencing the previous active cell, my guess would be that the active cell doesn't actually get changed until after the worksheet selection change event completes. So since you are trying to set the coordinates within this event (i.e. - before the event finishes), you are getting the previously active cell. Again, moving the code to the correct location fixes this issue.
Question 4: Why does it appear to align the bottom of the UserForm instead of the top? There appears to be a difference between the definition of "top" when it comes to cells (ranges) vs userforms. The top of the cell is measured from the first row whereas the top of the userform seems to be measured from the top of the Excel application. So in over words, if activecell.top and userform.top are both equal to 144, they will be different locations on the screen. This is because the top of activecell is 144 points down from the first row in the Excel spreadsheet while the top of the userform is 144 points down from the top of the Excel application (i.e. - the top of the Excel window), which is higher on the screen because the starting point (top of the Excel window) is higher than the starting point for activecell.top (first row in the spreadsheet). We can adjust for that by adding the height of the userform plus the height of the active cell to the top coordinate.
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim oRange As Range
Set oRange = Range("B3:C2000")
If Not Intersect(target, oRange) Is Nothing Then
frmCalendar.Show
End If
End Sub
Private Sub UserForm_Initialize()
With Me
.StartUpPosition = 0
.Top = ActiveCell.Top + ActiveCell.Height + .Height
.Left = ActiveCell.Offset(0, 1).Left
End With
End Sub
The answer provided by J. Garth did a great job explaining things, however, as I mentioned in my comments, while it works for this specific situation, it fails on various other scenarios (e.g. zoom level changes, split/frozen panes with the target range outside the sheet's initial visible range), not to mention that it doesn't take into account the header row/column (that are also subject to zoom level changes) and the 3D "frame/border" around a form when setting the position.
I spent a few days looking for a complete answer to cover all possibilities, and the only one that set a form's position very close to the correct one in almost all scenarios was this one by nerv, written as a result of this discussion on MSDN forums - most of the credit goes to him, obviously. I "merged" it with other bits of information and code from various other sources in order to avoid hardcoded variables, make the code 32bit and 64bit compatible and cover the mysterious 3D frame around the form issue.
Sheet code
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
UserForm1.Show
End Sub
Userform code
Private Sub UserForm_Initialize()
Dim pointcoordinates As pointcoordinatestype, horizontaloffsetinpoints As Double, verticaloffsetinpoints As Double
With Me
horizontaloffsetinpoints = (.Width - .InsideWidth) / 2
verticaloffsetinpoints = 1
Call GetPointCoordinates(ActiveCell, pointcoordinates)
.StartUpPosition = 0
.Top = pointcoordinates.Top - verticaloffsetinpoints
.Left = pointcoordinates.Left - horizontaloffsetinpoints
End With
End Sub
Module code
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Public Type pointcoordinatestype
Left As Double
Top As Double
Right As Double
Bottom As Double
End Type
Private pixelsperinchx As Long, pixelsperinchy As Long, pointsperinch As Long, zoomratio As Double
#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
#Else
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
#End If
Private Sub ConvertUnits()
Dim hdc As LongPtr
hdc = GetDC(0)
pixelsperinchx = GetDeviceCaps(hdc, LOGPIXELSX) ' Usually 96
pixelsperinchy = GetDeviceCaps(hdc, LOGPIXELSY) ' Usually 96
ReleaseDC 0, hdc
pointsperinch = Application.InchesToPoints(1) ' Usually 72
zoomratio = ActiveWindow.Zoom / 100
End Sub
Private Function PixelsToPointsX(ByVal pixels As Long) As Double
PixelsToPointsX = pixels / pixelsperinchx * pointsperinch
End Function
Private Function PixelsToPointsY(ByVal pixels As Long) As Double
PixelsToPointsY = pixels / pixelsperinchy * pointsperinch
End Function
Private Function PointsToPixelsX(ByVal points As Double) As Long
PointsToPixelsX = points / pointsperinch * pixelsperinchx
End Function
Private Function PointsToPixelsY(ByVal points As Double) As Long
PointsToPixelsY = points / pointsperinch * pixelsperinchy
End Function
Public Sub GetPointCoordinates(ByVal cellrange As Range, ByRef pointcoordinates As pointcoordinatestype)
Dim i As Long
ConvertUnits
Set cellrange = cellrange.MergeArea
For i = 1 To ActiveWindow.Panes.Count
If Not Intersect(cellrange, ActiveWindow.Panes(i).VisibleRange) Is Nothing Then
pointcoordinates.Left = PixelsToPointsX(ActiveWindow.Panes(i).PointsToScreenPixelsX(cellrange.Left))
pointcoordinates.Top = PixelsToPointsY(ActiveWindow.Panes(i).PointsToScreenPixelsY(cellrange.Top))
pointcoordinates.Right = pointcoordinates.Left + cellrange.Width * zoomratio
pointcoordinates.Bottom = pointcoordinates.Top + cellrange.Height * zoomratio
Exit Sub
End If
Next
End Sub
Most of the things above are self-explanatory, and they work flawlessly - at least from what I've been able to test. The only thing that still bothers me a bit (yeah, I know, but I'm a perfectionist) is that for some reason the form frame isn't exactly on the desired cell gridline (i.e. it's 1px lower) for odd numbered rows (while it all goes smooth for even numbered ones). If anyone can figure out why, please share this mystery with me, as I doubt that it's a simple rounding issue...
EDIT: Today, while working with Timers, I figured out how to avoid the differences between odd and even numbered rows that occured above: it was just a matter of declaring point values and outputs (as well as the zoom ratio) As Double
(i.e. floating-point numbers) instead of As Long
(i.e. integers). Silly mistake from my part - I've properly edited the code to correct it. I've added a verticaloffsetinpoints
variable to adjust the curious (but this time consistent) "1px lower than expected" vertical glitch that I couldn't find an explanation for (yet).
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With