Страницы: 1
RSS
Как привязать выпадающий список, к активной ячейке?, vba
 
Здравствуйте. Подскажите пожалуйста, у меня есть много выпадающий список, реализованный средствами vba, как мне прописать в коде, чтобы список выпадал от правого нижнего угла активной ячейки в экселе, а то она выпадает где захочет.
Код
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.Offset(0, 1), pointcoordinates)
        .StartUpPosition = 0
        .Top = pointcoordinates.Top - verticaloffsetinpoints
        .Left = pointcoordinates.Left - horizontaloffsetinpoints
    End With
    Dim ws          As Worksheet

'    Set wbCurrent = ActiveWorkbook("Бланк заказа") это как было в одной книге, а ниже я пытаюсь обратиться к той книге
    Set wbCurrent = Workbooks("Прайс Общий с макросами и многовыпадающитм списком")

    For Each ws In wbCurrent.Worksheets
        If InStr(1, ws.Name, ".", vbTextCompare) > 0 Then
            n = n + 1
            Level1.ListBox1.AddItem (ws.Name)
            If Len(ws.Name) > lenT Then lenT = Len(ws.Name)
        End If
    Next

    Dim ihWnd, hStyle
    If Val(Application.Version) < 9 Then
        ihWnd = FindWindow("ThunderXFrame", Me.Caption)
    Else
        ihWnd = FindWindow("ThunderDFrame", Me.Caption)
    End If
    hStyle = GetWindowLong(ihWnd, GWL_STYLE)
    hStyle = hStyle And Not WS_CAPTION And Not WS_BORDER
    SetWindowLong ihWnd, GWL_STYLE, hStyle
    SetWindowLong ihWnd, GWL_EXSTYLE, 0
    DrawMenuBar ihWnd
    Level1.Height = n * 20
    Level1.Height = Level1.Height + GWL_EXSTYLE
    Level1.Width = lenT * 2
    Level1.ListBox1.Height = Level1.Height
    Level1.ListBox1.Width = Level1.Width

End Sub

Я так понимаю, что снизу должно быть записано Level1.TextBox1.Top = ???????, и Level1.TextBox1.Left = ???????, только вот, что прописать за равенством
 
Еще в модуле есть такой код:
Код
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
Страницы: 1
Наверх