Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 288
  • Last Modified:

when making a custom shortcut or pop menu in word how can I break my menu options into different columns

when making a custom shortcut or pop menu in word how can I break my menu options into different columns
my choices on the shortcut menu are to many to fit on the screen when displayed in a single column I would like to display my menu selctions inmutliple columns How do I do this
0
Dov_B
Asked:
Dov_B
  • 2
  • 2
1 Solution
 
Patrick MatthewsCommented:
For a pop-up menu, I don't think you can show a multi-column layout.

What you could do, however, is use a CommandBarPopup instead of a CommandBarButton, to introduce a sub-level of menu options.
0
 
Dov_BAuthor Commented:
here is the code I got from a different expert that creates the overly long menu that wish to break into multiple columns
Sub ReplaceTextCommandbar()
    Dim ContextMenu As CommandBar
    Dim ctrl As CommandBarControl

    Dim synInfo As SynonymInfo
    Dim SynRange As Range
    Dim myRange As Range
    Dim aSynList() As String
    Dim idxSynList As Integer
    Dim strMessage As String
    Dim IdxMeaning As Integer
    Dim cbCtrlB As CommandBarButton
    Dim StrTemp As String

    ' Set ContextMenu to the Cell context menu.
    Set ContextMenu = Application.CommandBars("Text")

    ' Delete all controls
    For Each ctrl In ContextMenu.Controls
        ctrl.Delete
    Next ctrl


    Set SynRange = Selection.Range
    lngWordStart = SynRange.Words.First.Start
    lngWordEnd = lngWordStart + Len(Trim(SynRange.Words.First.Text))
    Set myRange = ActiveDocument.Range(lngWordStart, lngWordEnd)
    Set synInfo = myRange.SynonymInfo
    If synInfo.MeaningCount = 0 Then
        Set cbCtrlB = CommandBars("Text").Controls.Add(msoControlButton, , , 1)
        With cbCtrlB
            .Caption = "(No proposition)"
            .Enabled = False
        End With
    Else
        For IdxMeaning = 1 To UBound(synInfo.MeaningList)
            aSynList = synInfo.SynonymList(IdxMeaning)
            Set cbCtrlB = CommandBars("Text").Controls.Add(msoControlButton)
            With cbCtrlB
                .Caption = "Meaning: " + _
                    synInfo.MeaningList(IdxMeaning) + _
                    " (" + GetPartOfSpeech(synInfo.PartOfSpeechList(IdxMeaning)) + ")"
                .Enabled = False
                .BeginGroup = True
            End With
            For idxSynList = 1 To UBound(aSynList)
                Set cbCtrlB = CommandBars("Text").Controls.Add(msoControlButton)
                With cbCtrlB
                    .Caption = aSynList(idxSynList)
                    .OnAction = "ReplaceText"
                    .Parameter = aSynList(idxSynList)
                    If idxSynList = 1 Then .BeginGroup = True
                End With
            Next idxSynList
        Next IdxMeaning
    End If
'
End Sub

Open in new window

If need be I can also supply the subroutines and functions this macro calls
0
 
Patrick MatthewsCommented:
You could try this.  It creates a CommandBarPopup for each meaning, and as you select each one you get an additional list of the various synonyms for that meaning.



Sub ReplaceTextCommandbar()
    Dim ContextMenu As CommandBar
    Dim ctrl As CommandBarControl

    Dim synInfo As SynonymInfo
    Dim SynRange As Range
    Dim myRange As Range
    Dim aSynList() As String
    Dim idxSynList As Integer
    Dim strMessage As String
    Dim IdxMeaning As Integer
    Dim cbCtrlB As CommandBarButton
    Dim StrTemp As String
    Dim lngWordStart As Long, lngWordEnd As Long
    Dim cbp As CommandBarPopup
    
    ' Set ContextMenu to the Cell context menu.
    Set ContextMenu = Application.CommandBars("Text")

    ' Delete all controls
    For Each ctrl In ContextMenu.Controls
        ctrl.Delete
    Next ctrl


    Set SynRange = Selection.Range
    lngWordStart = SynRange.Words.First.Start
    lngWordEnd = lngWordStart + Len(Trim(SynRange.Words.First.Text))
    Set myRange = ActiveDocument.Range(lngWordStart, lngWordEnd)
    Set synInfo = myRange.SynonymInfo
    If synInfo.MeaningCount = 0 Then
        Set cbCtrlB = ContextMenu.Controls.Add(msoControlButton, , , 1)
        With cbCtrlB
            .Caption = "(No proposition)"
            .Enabled = False
        End With
    Else
        For IdxMeaning = 1 To UBound(synInfo.MeaningList)
            aSynList = synInfo.SynonymList(IdxMeaning)
            Set cbp = ContextMenu.Controls.Add(msoControlPopup)
            With cbp
                .Caption = "Meaning: " + _
                    synInfo.MeaningList(IdxMeaning) + _
                    " (" + GetPartOfSpeech(synInfo.PartOfSpeechList(IdxMeaning)) + ")"
                .Enabled = True
                .BeginGroup = True
            End With
            For idxSynList = 1 To UBound(aSynList)
                Set cbCtrlB = cbp.Controls.Add(msoControlButton)
                With cbCtrlB
                    .Caption = aSynList(idxSynList)
                    .OnAction = "ReplaceText"
                    .Parameter = aSynList(idxSynList)
                End With
            Next idxSynList
        Next IdxMeaning
    End If
    
    ContextMenu.ShowPopup
    
End Sub

Open in new window

0
 
Dov_BAuthor Commented:
is it possible for you to give me the code that would display all the definitions simoultaneously in different columns if not with a vba menu but with an ahk menu instead?
0

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now