활성 셀 옆에 사용자 양식을 정렬하려면 어떻게 해야 합니까?

활성 셀 옆에 사용자 양식을 정렬하려면 어떻게 해야 합니까?

지정된 범위의 셀을 클릭하면 열리는 월 단위 보기의 사용자 양식이 있습니다.이 SO 스레드는 저에게 기본적인 대본을 주었습니다.사용자 양식을 제가 기대하는 곳에 두지 않습니다.

범위에 있는 셀을 클릭할 때 사용자 양식을 여는 스크립트(특정 워크시트에 배치)는 다음과 같습니다.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

질문 1: UserForm StartUpPosition 속성을 다음과 같이 설정했습니다.0 - Manual- 이것이 맞습니까?

질문 2: 지정된 범위의 셀을 클릭하면 워크북을 연 후 처음으로 화면의 왼쪽 맨 위에 항상 사용자 양식이 열립니다. 그 이유는 무엇입니까?

질문 3: 지정된 범위의 셀을 클릭하면 첫 번째 셀 이후의 클릭에 대해 방금 클릭한 셀 대신 이전에 활성화된 셀에 대한 사용자 양식이 열립니다.이전 활성 셀이 아닌 방금 클릭한 셀에 대해 열리게 하려면 어떻게 해야 합니까?

질문 4: 상단 대신 사용자 양식 하단을 정렬하는 것처럼 보이는 이유는 무엇입니까?

다음 단계를 수행한 후:
1 - 셀 C15 클릭
2 - 사용자 양식 열기
3 - 사용자 양식 닫기
4 - 셀 16 클릭
5 - 사용자 양식 열기

이것이 제 눈에 보이는 것입니다.

편집: J. Garth의 솔루션을 구현한 후(Offset 속성을 (0, 2)로 변경한 후의 결과는 다음과 같습니다.

질문 1: UserForm StartUpPosition 속성이 0 - Manual로 설정되어 있습니다. 이게 맞나요?네, 맞습니다.아래 코드에서 이 속성을 코드에 설정합니다.

질문 2: 지정된 범위의 셀을 클릭하면 워크북을 연 후 처음으로 화면의 왼쪽 맨 위에 항상 사용자 양식이 열립니다. 그 이유는 무엇입니까?이에 대한 답은 3번 문제와 어느 정도 관련이 있다고 생각합니다.양식을 열기 위한 기본 위치인 것 같습니다.지금 코드를 가지고 있는 방법은 양식 상단과 왼쪽 좌표를 설정하려고 시도하는 것입니다.Worksheet_SelectionChange좌표가 실제로 설정되지 않기 때문에 이벤트가 작동하지 않습니다.좌표 설정을 사용자 폼 초기화 이벤트로 이동해야 합니다.

질문 3: 지정된 범위의 셀을 클릭하면 첫 번째 셀 이후의 클릭에 대해 방금 클릭한 셀 대신 이전에 활성화된 셀에 대한 사용자 양식이 열립니다. 이전 활성 셀이 아닌 방금 클릭한 셀에 대해 열리게 하려면 어떻게 해야 합니까?이 문제는 코드가 잘못된 위치에 있는 것과도 관련이 있습니다.위에 언급한 바와 같이, 조정 설정은 사용자 양식 초기화 이벤트에서 이루어져야 합니다.이전 활성 셀을 참조하는 이유에 관해서는 워크시트 선택 변경 이벤트가 완료될 때까지 활성 셀이 실제로 변경되지 않는 것으로 추측됩니다.따라서 이벤트 내에서 좌표를 설정하려는 경우(즉, 이벤트가 완료되기 전), 이전에 활성화된 셀을 얻는 것입니다.코드를 올바른 위치로 이동하면 이 문제가 해결됩니다.

질문 4: 상단 대신 사용자 양식 하단을 정렬하는 것처럼 보이는 이유는 무엇입니까?셀(범위)과 사용자 양식에 관한 "위"의 정의는 차이가 있는 것으로 보입니다.셀 상단은 첫 번째 행에서 측정되는 반면 사용자 양식 상단은 엑셀 어플리케이션 상단에서 측정되는 것 같습니다.즉, activecell.top과 userform.top이 모두 144인 경우, 화면에서 서로 다른 위치가 됩니다.이는 엑셀 스프레드시트의 첫번째 행에서 활성 셀의 상단이 144포인트 내려간 반면, 사용자 양식의 상단은 엑셀 어플리케이션의 상단(즉, 엑셀 윈도우의 상단)에서 144포인트 내려간 상태이기 때문인데, 이는 시작점(엑셀 윈도우의 상단)이 A의 시작점보다 높기 때문에 화면에서 더 높은 것입니다.ctivcell.top(스프레드시트의 첫번째 행).상단 좌표에 사용자 폼의 높이와 활성 셀의 높이를 추가하여 조정할 수 있습니다.

시트모듈코드

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

J. Garth가 제공한 답변은 설명을 잘했지만, 제가 코멘트에서 언급했듯이, 이 특정한 상황에서는 효과가 있지만, 다양한 다른 시나리오(예: 줌 레벨 변경, 시트의 초기 가시 범위 밖의 대상 범위에서 분할/동결 창)에서는 실패합니다.위치를 설정할 때 (줌 레벨이 변경될 수도 있는) 헤더 행/열과 폼 주변의 3D "프레임/경계"를 고려하지 않는 것은 말할 것도 없습니다.

저는 며칠 동안 모든 가능성을 포괄할 수 있는 완전한 답변을 찾았는데, 거의 모든 시나리오에서 양식의 위치를 정확한 위치에 매우 가깝게 설정한 유일한 사람은 MSDN 포럼에 대한 논의의 결과로 작성된 신경질적인 답변이었습니다. 대부분의 공로는 분명히 그에게 돌아갔습니다.저는 하드코딩된 변수를 방지하고 코드 32비트와 64비트를 호환하며 폼 문제를 둘러싼 의문의 3D 프레임을 다루기 위해 다른 소스의 정보 및 코드를 다른 비트와 "병합"했습니다.

시트코드

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    UserForm1.Show
End Sub

유저폼코드

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

모듈코드

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

위의 것들은 대부분 자기 설명적이고, 적어도 제가 시험해 볼 수 있었던 것을 보면 흠잡을 데 없이 잘 작동합니다.여전히 저를 조금 괴롭히는 유일한 것은(네, 알고 있지만 완벽주의자입니다) 어떤 이유에서인지 폼 프레임이 홀수 번호 행에 대해 원하는 셀 그리드 라인에 정확히 있지 않다는 것입니다(즉, 1px 더 낮음). (짝수 번호 행의 경우 모든 것이 매끄럽습니다).).이유를 알아낼 수 있는 사람이 있다면 이 수수께끼를 저와 공유해 주세요. 단순한 반올림 문제는 아닐 것이기 때문에...

편집: 오늘 Timers와 함께 일하면서 위에서 나타난 홀수 행과 짝수 행의 차이를 피하는 방법을 알아냈습니다. 포인트 값과 출력(줌 비율뿐만 아니라)을 선언하는 문제였습니다.As Double(즉, 부동 소수점 숫자) 대신As Long(즉, 정수).제가 한 어리석은 실수입니다. 코드를 적절히 편집해서 수정했습니다.추가했습니다.verticaloffsetinpoints(아직) 설명을 찾을 수 없었던 호기심 많은 (그러나 이번에는 일관된) "예상보다 1px 낮은" 수직 결함을 조정하는 변수.

GetDeviceCaps, GetDC, Release를 선언하여Module 1의 DC기능, 클릭된 active cell 옆에 사용자 폼 정렬하였습니다. (32비트, 64비트 버전의 Excel에서 코드를 확인하였습니다.)

Type POINTAPI
    X As Long
    Y As Long
End Type

#If VBA7 Then
    Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDc As LongPtr, ByVal nIndex As Long) As Long
    Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDc As LongPtr) As Long
    Dim hDc As LongPtr
#Else
    Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDc As Long, ByVal nIndex As Long) As Long
    Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDc As Long) As Long
    Dim hDc As Long
#End If
...

코드 소스 및 샘플 파일

언급URL : https://stackoverflow.com/questions/41884148/how-do-i-align-a-userform-next-to-the-active-cell