Sub CreateShortcut()
    Dim myBar As CommandBar
    Dim myItem As CommandBarControl
    Dim pmyItem As CommandBarControl
    
    Set myBar = CommandBars.Item("PivotTable Context Menu")
    
    Set myItem = myBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
    With myItem
        .Caption = "Äåòàëèçàöèÿ ïî ÖÔÎ"
        .OnAction = "FillCommentForCFO"
    End With
    
    Set myItem = myBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
    With myItem
        .Caption = "Äåòàëèçàöèÿ ïî Êîíòàðãåíòàì"
        .OnAction = "FillCommentForContractors"
    End With
    
    Set myItem = myBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
    With myItem
        .Caption = "Äåòàëèçàöèÿ ïî Àíàëèòèêàì"
        .OnAction = "FillCommentForAnalytics"
    End With
    
End Sub

Sub FillCommentForCFO()
    Call FillCommentForPivotCell(1, Selection)
End Sub

Sub FillCommentForContractors()
    Call FillCommentForPivotCell(2, Selection)
End Sub
Sub FillCommentForAnalytics()
    Call FillCommentForPivotCell(3, Selection)
End Sub

Sub FillCommentForPivotCell(CommmentType As Integer, Target As Range)
    
    'Dim Target As Range
    Dim Comment As String
    Dim cell As PivotCell
    
    If Err.Number <> 0 Then GoTo done
    If TypeName(Target.Value) <> "Double" Then GoTo done
    On Error GoTo done
    Set cell = Target.PivotCell
    On Error GoTo 0
    If cell.PivotCellType = xlPivotCellValue Then
        Comment = GenerateMDX(cell, CommmentType)
        Call CreateComment(Comment, Target)
    End If
    
done:
    On Error GoTo 0

End Sub

Function GenerateMDX(pcell As PivotCell, CommmentType As Integer)
    Dim pcache As PivotCache
    Dim pf As PivotField
    Dim mdx As String
    Dim axe As String
    
    Dim Conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    
    Select Case CommmentType
    Case 1
        axe = "[DimCFOAndOrg].[CFO ID].[CFO ID]"
        Comment = "&#214;&#212;&#206;:"
    Case 2
        axe = "[Dim Contractors].[Contractor ID].[Contractor ID]"
        Comment = "&#202;&#238;&#237;&#242;&#240;&#224;&#227;&#229;&#237;&#242;&#251;:"
    Case 3
        axe = "[Dim Analytics].[Analytic ID].[Analytic ID]"
        Comment = "&#192;&#237;&#224;&#235;&#232;&#242;&#232;&#234;&#232;:"
    End Select
    
    'Dim Comment As String

    'Set Comment = ""
    
    
    Set pt = pcell.Parent
    Set pcache = pt.PivotCache
    
    If Not pcache.IsConnected Then
        pcache.MakeConnection
    End If
    
    Set adoCmd = New ADODB.Command
    Set rs = New ADODB.Recordset
    Set rs.ActiveConnection = pcache.ADOConnection
    Set Conn = adoCmd.ActiveConnection

    'recs.CommandText = "select non empty {measures.members} on 0, non empty " & axe & " on 1 from (select " & pcell.mdx & " on 0 from [" & pcache.CommandText & "])"
    'Set resc = adoCmd.Execute
    rs.Open ("select non empty {measures.members} on 0, non empty " & axe & " on 1 from (select " & pcell.mdx & " on 0 from [" & pcache.CommandText & "])")
    Count = 0
    While Not rs.EOF
    Count = Count + 1
    Comment = Comment & vbCrLf & " " & Count & ") " & rs(0) & ": " & rs(1) & ""
   
   
       rs.MoveNext
    Wend
    
    
    rs.Close
    
    GenerateMDX = Comment
    
End Function

Sub CreateComment(txt As String, Target As Range)
    
    If Not (Target.Comment Is Nothing) Then
    Target.Comment.Text Text:=txt
    Else
    Target.AddComment (txt)
    End If
    
End Sub

Sub DeleteShortcut()
    Dim myBar As CommandBar
    Dim myItem As CommandBarControl
    
    Set myBar = CommandBars.Item("PivotTable Context Menu")
    
    Set myItem = myBar.Controls.Item("&#196;&#229;&#242;&#224;&#235;&#232;&#231;&#224;&#246;&#232;&#255; &#239;&#238; &#214;&#212;&#206;")
    If Not (myItem Is Nothing) Then
    myItem.Delete
    End If
    
    
    Set myItem = myBar.Controls.Item("&#196;&#229;&#242;&#224;&#235;&#232;&#231;&#224;&#246;&#232;&#255; &#239;&#238; &#192;&#237;&#224;&#235;&#232;&#242;&#232;&#234;&#224;&#236;")
    If Not (myItem Is Nothing) Then
    myItem.Delete
    End If
    
    Set myItem = myBar.Controls.Item("&#196;&#229;&#242;&#224;&#235;&#232;&#231;&#224;&#246;&#232;&#255; &#239;&#238; &#202;&#238;&#237;&#242;&#224;&#240;&#227;&#229;&#237;&#242;&#224;&#236;")
    If Not (myItem Is Nothing) Then
    myItem.Delete
    End If
    
    
End Sub

Sub CommentsRefresh()

    Dim cell As Range
    i = 1
    Dim Sh As Worksheet
    Set Sh = ActiveSheet
    For Each Comment In Sh.Comments
        Set cell = Comment.Parent.Cells
        Select Case Left(Comment.Text, 1)
        Case "&#214;"
            Call FillCommentForPivotCell(1, cell)
        Case "&#202;"
            Call FillCommentForPivotCell(2, cell)
        Case "&#192;"
            Call FillCommentForPivotCell(3, cell)
        End Select
    Next Comment
    

End Sub