Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Получить данные, отображаемые во всплывающей подсказке (ToolTips) для полей Сводной таблицы
 
#1
03.04.2026 14:49:52
Надеюсь, скрина достаточно :cry:  

На картинке - всплывающая подсказка к ячейке.
Как можно из ячейки в макросе выцарапать тот текст, который в подсказке.

UPD. Главное не написала, совсем запуталась имеет ли это значение или нет.
Сводная - на основе модели данных.
Изменено: Sanja - 04.04.2026 14:08:24 (Изменил название на более подходящее к вопросу)
 
 
 
#2
03.04.2026 15:06:11
Насколько я понял эти данные можно получить из свойств объекта PivotField, а саму подсказку можно только включать/отключать PivotTable.DisplayContextTooltips
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
03.04.2026 15:35:27
Мне надо не включать, а именно этот текст готовенький вот как на картинке текстом.
Особенно интересуют гирлянды (пусто) в подписях, а не названия полей.

Перебираю по косточкам pivotField, пока не нашла  :cry:
 
 
 
#4
03.04.2026 15:51:42
Ну приложите фай-пример, покопаем вместе)
Согласие есть продукт при полном непротивлении сторон
 
 
 
#5
03.04.2026 16:04:10
файл с моделью данных не лезет ни в какие лимиты. Так что архивом.
Но это вообще любая сводная.

Вариант искать значения ячеек на листе довольно дурацкий, т.к. при выполнении макроса и изменении сводной это значения могут не остаться на месте.
Изменено: Xel - 03.04.2026 16:06:00
 
 
 
#6
03.04.2026 17:00:25
Цитата
Xel написал: Вариант искать значения ячеек на листе довольно дурацкий

Попробуйте такой макрос, может что-то для себя примените
Код
Sub GetToolTip()
Dim pvTable As PivotTable
Dim pvRFld As PivotField
Dim iCl As Range
Dim iTxt$
Set pvTable = Worksheets("Лист1").PivotTables(1)
For Each pvRFld In pvTable.RowFields
  With pvRFld.DataRange
    For Each iCl In .Cells
      iTxt = IIf(iTxt = "", iCl.Value, iTxt & vbCrLf & iCl.Value)
    Next
    MsgBox pvRFld.Caption & vbCrLf & iTxt
    iTxt = Empty
  End With
Next
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
04.04.2026 10:10:42
Еще поигрался со Сводной.
Заменяем штатную подсказку примечанием (в новых версиях - заметка) или сообщением
Потыкайте мышкой в поля данных
В модуль листа
Скрытый текст
Согласие есть продукт при полном непротивлении сторон
 
 
 
#8
04.04.2026 18:50:02
А можно попробовать и напрямую из сводной данные получить:
Код
Sub Test_GetPTTooltip()
    Debug.Print GetPTTooltip(ActiveCell)
End Sub
'---------------------------------------------------------------------------------------
' Author : Щербаков Дмитрий(The_Prist)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          https://www.excel-vba.ru
'          info@excel-vba.ru
' Purpose: Получение подсказки из ячейки сводной таблицы
'---------------------------------------------------------------------------------------
Function GetPTTooltip(rCell As Range)
    Dim optc As PivotCell
    Dim pf As PivotField
    Dim pi As PivotItem, pc, pp As Object
    Dim s$, spiv$, sOut$, asp
    Dim lp&
    
    On Error Resume Next
    Set optc = rCell.PivotCell
    Err.Clear
    If Not optc Is Nothing Then
        sOut = optc.PivotField.Caption & vbLf
        Select Case optc.PivotCellType
        Case xlPivotCellValue 'любая ячейка в области значений
            If optc.RowItems.Count Then
                sOut = sOut & "Строка: "
                For Each pi In optc.RowItems
                    spiv = pi.Value
                    If Len(spiv) Then
                        asp = Split(spiv, "&")
                        If UBound(asp) > 0 Then
                            spiv = asp(UBound(asp))
                            If spiv = "" Then
                                spiv = "(пусто)"
                            Else
                                spiv = Mid(spiv, 2, Len(spiv) - 2)
                            End If
                        End If
                    End If
                    If Len(spiv) Then
                        sOut = sOut & " - " & spiv
                    End If
                Next
            End If
            If optc.ColumnItems.Count Then
                sOut = sOut & "Столбец: "
                For Each pi In optc.ColumnItems
                    spiv = pi.Value
                    If Len(spiv) Then
                        asp = Split(spiv, "&")
                        If UBound(asp) > 0 Then
                            spiv = asp(UBound(asp))
                            If spiv = "" Then
                                spiv = "(пусто)"
                            Else
                                spiv = Mid(spiv, 2, Len(spiv) - 2)
                            End If
                        End If
                    End If
                    If Len(spiv) Then
                        sOut = sOut & " - " & spiv
                    End If
                Next
            End If
        Case xlPivotCellPivotItem 'любая ячейка в области строк или столбцов
            Set pp = optc.PivotRowLine
            If Not pp Is Nothing Then
                If pp.PivotLineCells.Count Then
                    sOut = sOut & "Строка: "
                    For Each pc In pp.PivotLineCells
                        spiv = pc.PivotItem.LabelRange.Value2
                        If Len(spiv) Then
                            sOut = sOut & " - " & spiv
                        End If
                    Next
                End If
            End If
            Set pp = Nothing
            Set pp = optc.PivotColumnLine
            If Not pp Is Nothing Then
                If pp.PivotLineCells.Count Then
                    sOut = sOut & "Столбец: "
                    For Each pc In pp.PivotLineCells
                        spiv = pc.PivotItem.LabelRange.Value2
                        If Len(spiv) Then
                            sOut = sOut & " - " & spiv
                        End If
                    Next
                End If
            End If
        End Select
    End If
    GetPTTooltip = sOut
End Function

Можно, конечно, подсократить, причесать(добавить итоги и т.п.) - но времени особо нет на это.
Изменено: Дмитрий(The_Prist) Щербаков - 04.04.2026 19:23:29
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
Страницы: 1
Читают тему
Наверх