Здравствуйте. Подскажите пожалуйста, у меня есть много выпадающий список, реализованный средствами 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
[/vba] Я так понимаю, что снизу должно быть записано Level1.TextBox1.Top = ???????, и Level1.TextBox1.Left = ???????, только вот, что прописать за равенством
Здравствуйте. Подскажите пожалуйста, у меня есть много выпадающий список, реализованный средствами 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
[/vba] Я так понимаю, что снизу должно быть записано 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
[/vba]
Еще в модуле есть такой код: [vba]
Код
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