Two questions

  • Thread starter Thread starter pete
  • Start date Start date
P

pete

I have two questions:
1. I have links that do not work. Is there a "Find link"
macro or add-on somewhere?
2. On my spreadsheet I created a "control button" that
gives the user options to select. How can I make
this "control button" float so that it shows on the
screen wherever the user scrolls to.

Thanks.
 
Harald: Can you show me how to put a button on a floating
custom toolbar?
Thanks for your help.
 
pete said:
Harald: Can you show me how to put a button on a floating
custom toolbar?
Thanks for your help.
Click to expand...

Paste this into a standard module and run. (Can't remember what I wrote it
for originally :-)

Option Explicit 'TOP of module

Sub AddCell()
Call Add2Combo(ActiveCell.Address)
End Sub

Sub Add2Combo(CellAdress As String)
On Error Resume Next
If Application.CommandBars("Messenger") Is Nothing Then Call CreateToolbar
On Error GoTo 0
CommandBars("Messenger").Controls(1).AddItem CellAdress
End Sub

Sub CreateToolbar()
Beep
Call KillIt(True)
Application.CommandBars.Add(Name:="Messenger").Visible = True

Application.CommandBars("Messenger").Controls.Add _
Type:=msoControlDropdown ', ID:="List"
With Application.CommandBars("Messenger").Controls(1)
.DropDownLines = .ListCount
.DropDownWidth = 250
.OnAction = _
ThisWorkbook.Name & "!GoThere"
.TooltipText = "Select a cell"
.Caption = "Cap"
End With

Application.CommandBars("Messenger").Controls.Add _
Type:=msoControlButton
With Application.CommandBars("Messenger").Controls(2)
.Caption = "Add cell"
.Style = msoButtonIconAndCaption
.FaceId = 1087
.OnAction = ThisWorkbook.Name & "!AddCell"
End With


Application.CommandBars("Messenger").Controls.Add _
Type:=msoControlButton
With Application.CommandBars("Messenger").Controls(3)
.Caption = "Kill me"
.Style = msoButtonIconAndCaption
.FaceId = 608
.OnAction = ThisWorkbook.Name & "!KillIt"
End With
Application.CommandBars("Messenger").Top = 150
Application.CommandBars("Messenger").Left = 150
End Sub

Sub GoThere()
Range(Application.CommandBars("Messenger").Controls(1).Text).Select
End Sub

Sub KillIt(Optional DontAsk As Boolean)
On Error Resume Next
If DontAsk = False Then
If MsgBox("This will remove the cell list forever. Continue ?", _
vbYesNo + vbQuestion + vbDefaultButton2) = vbNo Then Exit Sub
End If
Application.CommandBars("Messenger").Delete
End Sub
 
Back
Top