Есть ли способ показать ячейки с длинными комментариями в качестве всплывающей подсказки при наведении на ячейку? - PullRequest
0 голосов
/ 04 января 2019

У меня есть лист Excel с колонкой ячеек, каждая из которых содержит очень длинные комментарии - и я не хочу увеличивать ширину ячеек, поскольку она будет слишком широкой, а содержимое будет просматриваться только изредка. Содержимое каждой ячейки является динамическим, извлекается из внешнего источника данных и поэтому может время от времени меняться.

Что я хотел бы сделать, так это уметь парить над ячейкой, а затем отображать все ее содержимое в виде всплывающей подсказки или комментария, но исчезать, если не навести на нее курсор.

(я знаю, что могу настроить их как проверку данных, но так как контент динамический, это не сработает).

Мне было интересно, возможно ли это сделать? Кроме того, мои навыки работы с VBA довольно примитивны, поэтому, если кто-то действительно сможет помочь, вы сможете сказать мне точно, куда вставить код VBA и как заставить его «работать»!

Заранее спасибо, если кто-нибудь сможет помочь. Брайан

Ответы [ 2 ]

0 голосов
/ 04 января 2019

мои навыки работы с VBA довольно примитивны, поэтому, если кто-то действительно сможет помочь, вы сможете сказать мне точно, куда вставить код VBA и как заставить его "работать"!

Я обычно не отвечаю на вопросы, которые не требуют усилий, но этот вопрос выходит за рамки обычного вопроса, поэтому я попытаюсь ответить на него.

Можно показать содержимое, когда hovering над ячейкой. Когда я говорю hovering, я имею в виду hovering, а не Selecting клетка.

Ссылка на файл примера размещена в конце этого сообщения.

1. В вашем файле перейдите в редактор VBA и вставьте форму пользователя. Затем поместите элемент управления меткой и измените его размер, чтобы заполнить пользовательскую форму, как показано на рисунке ниже

enter image description here

2. Вставьте этот код в форму пользователя

Код

Option Explicit

Const GWL_STYLE = -16
Const WS_CAPTION = &HC00000

Private Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Declare Function DrawMenuBar _
Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function FindWindowA _
Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Sub HideTitleBar(frm As Object)
    Dim lngWindow As Long
    Dim lFrmHdl As Long
    lFrmHdl = FindWindowA(vbNullString, frm.Caption)
    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
    lngWindow = lngWindow And (Not WS_CAPTION)
    Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
    Call DrawMenuBar(lFrmHdl)
End Sub

'~~> Hide Title bar and border using API    
Private Sub UserForm_Initialize()
    HideTitleBar UserForm1
End Sub

'~~> Stop the execution of the code
Private Sub Label1_Click()
    StopLoop = True
    Unload Me
End Sub

Это означает, что он удаляет строку заголовка и границу формы.

3. Затем вставьте модуль и вставьте туда этот код

Public Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long

Public Type POINTAPI
    x As Long
    y As Long
End Type

Public StopLoop As Boolean

Sub StartShowingCellContents()
    Dim lngCurPos As POINTAPI
    Dim rng As Range

    StopLoop = False

    Do
        '~~> Get the cursor position
        GetCursorPos lngCurPos

        '~~> This will give the cell address "under" the cursor
        Set rng = ActiveWindow.RangeFromPoint(lngCurPos.x, lngCurPos.y)

        If Not rng Is Nothing Then
            If Not rng.Cells.CountLarge > 1 Then
                With UserForm1
                    '~~> Display cell value in the label
                    .Label1.Caption = rng.Value
                    '~~> Show the form modeless
                    .Show vbModeless
                    DoEvents
                End With
            End If
        End If

        DoEvents

        '~~> Stop the loop (invoked by clicking on the userform's label
        If StopLoop = True Then Exit Sub
    Loop
End Sub

4. И все готово. Для начала запустите процедуру Sub StartShowingCellContents(). И чтобы остановить, просто нажмите на пользовательскую форму

5. В действии. Я щелкнул изображение с помощью телефона, чтобы вы могли видеть курсор в верхней части этой ячейки.

enter image description here

ВАЖНО:

  1. Вы не сможете выполнять какие-либо операции, такие как копирование, вставка, удаление и т. Д., Пока не будет запущен код. Остановите код, сделайте то, что вы хотите, а затем снова запустите код.
  2. Не стесняйтесь настраивать код по своему вкусу.
  3. Образец файла можно загрузить с ЗДЕСЬ
0 голосов
/ 04 января 2019

Что-то вроде этого должно работать, единственное, что мне еще нужно решить, - это автоматически изменить размер окна комментария. Авторазмер по умолчанию не делает большую работу, поэтому я сделал статический размер. Это работает, только если вы щелкнете по ячейке, поэтому я должен указать на это.

Добавьте этот код к коду позади объекта ThisWorkbook, и это будет работать для всех рабочих листов в рабочей книге. Если вы хотите это только для одного листа, добавьте его в раздел Worksheet_SelectionChange позади интересующего вас рабочего листа (листов).

Private LastTarget As Range

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If Not LastTarget Is Nothing Then
        If Not LastTarget.Comment Is Nothing Then LastTarget.Comment.Delete
    End If

    If Not Trim$(Target.Value) = vbNullString Then
        If Target.Comment Is Nothing Then
            Target.AddComment Target.Text
            Target.Comment.Visible = True
            Target.Comment.Shape.Width = 300 'Change as needed
            Target.Comment.Shape.Height = 300 'Change as needed
            Target.Comment.Shape.Fill.Transparency = 0.6 'Make the comment a little see through
        End If
    End If

    Set LastTarget = Target
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...