Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
Hi,
I need a macro to list all sheets in a workbook and be able to select from the list by double clicking the name of the sheet. (I am already aware of the possibility to right click the symbol left corner in Excel). The code below almost does the job, but I have to write the number corresponding to the sheet and press enter. Can somebody help with the code, so that I can double click the name. Kaj Pedersen myShts = ActiveWorkbook.Sheets.Count For i = 1 To myShts myList = myList & i & " - " & ActiveWorkbook.Sheets(i).Name & " " & vbCr Next i Dim mySht As Single mySht = InputBox("Select sheet to go to." & vbCr & vbCr & myList) Sheets(mySht).Select |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
In a standard module:
Option Explicit Sub ListSheets() Dim i As Integer Load fGoToSheet For i = 1 To ActiveWorkbook.Sheets.Count fGoToSheet.ListBox1.AddItem Sheets(i).Name Next 'i fGoToSheet.Show End Sub In the code window behind a userform named "fGoToSheet": Option Explicit Private Sub CommandButton1_Click() Unload Me End Sub Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Sheets(ListBox1.List(ListBox1.ListIndex)).Activate End Sub ...where CommandButton1's Caption is "OK". Note that the userform will stay loaded until closed by the user. If you want it to close automatically when the user double-clicks a sheetname then remove the button and append its code to the ListBox1_DblClick event as follows... Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Sheets(ListBox1.List(ListBox1.ListIndex)).Activate : Unload Me End Sub If you want to have this added to the cells right-click popup menu then it's a bit more involved, but doable. -- Garry Free usenet access at http://www.eternal-september.org ClassicVB Users Regroup! comp.lang.basic.visual.misc |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
On Sun, 9 Oct 2011 19:45:49 +0200, "KP" <none wrote:
Hi, I need a macro to list all sheets in a workbook and be able to select from the list by double clicking the name of the sheet. (I am already aware of the possibility to right click the symbol left corner in Excel). The code below almost does the job, but I have to write the number corresponding to the sheet and press enter. Can somebody help with the code, so that I can double click the name. Kaj Pedersen myShts = ActiveWorkbook.Sheets.Count For i = 1 To myShts myList = myList & i & " - " & ActiveWorkbook.Sheets(i).Name & " " & vbCr Next i Dim mySht As Single mySht = InputBox("Select sheet to go to." & vbCr & vbCr & myList) Sheets(mySht).Select You could set up a List Box with the sheet names in it, or you could write the sheetnames to a worksheet and use Hyperlink to access the individual sheets. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
I need a macro to list all sheets in a workbook and be able to select
from the list by double clicking the name of the sheet. I know this isn't what you asked for, but perhaps this UserForm solution I posted several years ago to an old newsgroup message might be of interest to you. Here is it, presented as I originally posted it (basically, it shows a ListBox of all sheet names which you can click directly in (and get taken to the clicked on tab name) or start to type the beginning text of a tab name into a text box which will parse down the list of tab names so you can either click or arrow down to make a selection). My previous post follows.... Okay, here is something I think will meet your needs (don't be put off by the its length, it is really worth the effort)... its a UserForm which lets you type partial entries, pick from a list and takes you to the indicated sheet. I'm going to assume you do not know how to implement a UserForm and talk you through the whole process. Go to the Visual Basic editor (press Alt+F11 from any worksheet). Once there, click Insert/UserForm form the menu bar. You will see a blank form and a window with the caption Toolbox. The Toolbox has controls (TextBox, ListBox, etc.) on it that you will be placing on the blank UserForm (note.. the Toolbox is displayed only when the UserForm has focus). Before we put any controls on the UserForm, let's rename it. On the left side of the VB editor should be a window with the caption "Properties - UserForm1" (if you don't see this, press F4). The first field of the Properties window is labeled (Name) and next to it is the word UserForm1... click the word UserForm1 and type GoToSheetSelector in its place. Next, look down and find the Height and Width properties and set them to these values... Height = 230 Width = 165 These, and other properties for the controls we will be putting on the UserForm, are initial settings to get you started... you will be able to modify them later to suit your own tastes. The rest of the default values for the UserForm should be fine for now. Okay, let's set the UserForm up. There will only be two controls on the UserForm... a TextBox and a ListBox. First, the TextBox. Give the UserForm focus (to make the Toolbox visible) and click on the TextBox icon in the Toolbox (it is one with the lower case letters "ab followed by a vertical bar) to place it. You can use the resize handles to make the TextBox whatever size you want and you can click/drag it to any position you want, but we will use the Properties window to set them to exact values. There are only seven properties I want you to set initially. In the Properties window, find and set the following values... Height = 18 Left = 10 MultiLine = True Top = 10 Width = 140 WordWrap = False The seventh property is actually a dialog box for an object where you will set 3 properties of the object. Click on the field to the right of the Font property and you will see a little button with 3 dots in it... click that button. On the dialog box that appears, set these properties.... Font = Arial Font Style = Bold Size = 10 Okay, that takes care of the TextBox. Next, let's add the ListBox. Click the ListBox icon in the Toolbox (it is a rectangle with 3 horizontal lines on the left and what are supposed to be up/down arrows on the right... if you hover the mouse over the controls, a tooltip will appear with the control's name... you are looking for ListBox) and then click/drag on the UserForm to place it. Set the following properties for it in the Properties window... Height = 165 Left = 10 Top = 38 Width = 140 Okay, that should take care of setting up the UserForm; now let's install the code. Press F7 to bring up the code window for the UserForm (or simply double click anywhere on the UserForm or one of its controls). Delete anything you see in the code window that appears and copy/paste **all** of the marked off code that follows my signature into this code window. Okay, that takes care of the UserForm itself, now we just need a way to call it up. Still in the VB editor, click Insert/Module from the menu bar. Another code window will appear; copy/paste this into it... Sub CallGoToSheetSelector() GoToSheetSelector.Show End Sub Okay, that is pretty much it... the UserForm is usable right now. From any sheet in your workbook, press Alt+F8, select CallGoToSheetSelector from the list and click Run (we can do this differently and I'll explain how in a moment). The UserForm will be displayed showing all sheets in your workbook in the ListBox and the cursor will be in the TextBox. Here is how the UserForm works. Start to type in the name of a sheet in your workbook and the ListBox will show only sheet names starting with that text. You can continue to type until only one name is left in the ListBox (you might not have to type the full sheet name to completion for this to happen) and then press the Return key to go to that sheet. But you don't have to keep typing until there is only one sheet name left in the ListBox... at any time, you can press either the down or right arrow and you will find yourself in the ListBox itself where you can continue to use the arrow keys to place the highlight on the sheet name you want, then press Return to go to that sheet. If you find yourself in the TextBox by mistake, just press the left arrow key to put yourself back into the TextBox. You can edit the text in the TextBox and the ListBox will display the sheet names corresponding to the type in text. If you type text that is not the starting text of a sheet name, the ListBox will not display anything (if you mistype a letter so this occurs, just delete the mistyped letter and the ListBox will adjust accordingly). Oh, and you can also just click an entry in the ListBox with your mouse and that will take you to the clicked on sheet name. Okay, now about alternate methods of activating the UserForm (besides always using Alt+F8/Select/Run). Go to any worksheet and press Alt+F8, select CallGoToSheetSelector from the list and then click the Options button. This will bring up a dialog box which lets you assign a shortcut key to your macro. Type a lower case "g" in the indicated field, then click OK and close the dialog box. Now, from any sheet in your workbook, press Ctrl+g and your UserForm will appear, ready to use. I think that is everything. If you have any questions, feel free to post back. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
I need a macro to list all sheets in a workbook and be able to select
from the list by double clicking the name of the sheet. I know this isn't what you asked for, but perhaps this UserForm solution I posted several years ago to an old newsgroup message might be of interest to you. Here is it, presented as I originally posted it (basically, it shows a ListBox of all sheet names which you can click directly in (and get taken to the clicked on tab name) or start to type the beginning text of a tab name into a text box which will parse down the list of tab names so you can either click or arrow down to make a selection). My previous post follows.... Okay, here is something I think will meet your needs (don't be put off by the its length, it is really worth the effort)... its a UserForm which lets you type partial entries, pick from a list and takes you to the indicated sheet. I'm going to assume you do not know how to implement a UserForm and talk you through the whole process. Go to the Visual Basic editor (press Alt+F11 from any worksheet). Once there, click Insert/UserForm form the menu bar. You will see a blank form and a window with the caption Toolbox. The Toolbox has controls (TextBox, ListBox, etc.) on it that you will be placing on the blank UserForm (note.. the Toolbox is displayed only when the UserForm has focus). Before we put any controls on the UserForm, let's rename it. On the left side of the VB editor should be a window with the caption "Properties - UserForm1" (if you don't see this, press F4). The first field of the Properties window is labeled (Name) and next to it is the word UserForm1... click the word UserForm1 and type GoToSheetSelector in its place. Next, look down and find the Height and Width properties and set them to these values... Height = 230 Width = 165 These, and other properties for the controls we will be putting on the UserForm, are initial settings to get you started... you will be able to modify them later to suit your own tastes. The rest of the default values for the UserForm should be fine for now. Okay, let's set the UserForm up. There will only be two controls on the UserForm... a TextBox and a ListBox. First, the TextBox. Give the UserForm focus (to make the Toolbox visible) and click on the TextBox icon in the Toolbox (it is one with the lower case letters "ab followed by a vertical bar) to place it. You can use the resize handles to make the TextBox whatever size you want and you can click/drag it to any position you want, but we will use the Properties window to set them to exact values. There are only seven properties I want you to set initially. In the Properties window, find and set the following values... Height = 18 Left = 10 MultiLine = True Top = 10 Width = 140 WordWrap = False The seventh property is actually a dialog box for an object where you will set 3 properties of the object. Click on the field to the right of the Font property and you will see a little button with 3 dots in it... click that button. On the dialog box that appears, set these properties.... Font = Arial Font Style = Bold Size = 10 Okay, that takes care of the TextBox. Next, let's add the ListBox. Click the ListBox icon in the Toolbox (it is a rectangle with 3 horizontal lines on the left and what are supposed to be up/down arrows on the right... if you hover the mouse over the controls, a tooltip will appear with the control's name... you are looking for ListBox) and then click/drag on the UserForm to place it. Set the following properties for it in the Properties window... Height = 165 Left = 10 Top = 38 Width = 140 Okay, that should take care of setting up the UserForm; now let's install the code. Press F7 to bring up the code window for the UserForm (or simply double click anywhere on the UserForm or one of its controls). Delete anything you see in the code window that appears and copy/paste **all** of the marked off code that follows my signature into this code window. Okay, that takes care of the UserForm itself, now we just need a way to call it up. Still in the VB editor, click Insert/Module from the menu bar. Another code window will appear; copy/paste this into it... Sub CallGoToSheetSelector() GoToSheetSelector.Show End Sub Okay, that is pretty much it... the UserForm is usable right now. From any sheet in your workbook, press Alt+F8, select CallGoToSheetSelector from the list and click Run (we can do this differently and I'll explain how in a moment). The UserForm will be displayed showing all sheets in your workbook in the ListBox and the cursor will be in the TextBox. Here is how the UserForm works. Start to type in the name of a sheet in your workbook and the ListBox will show only sheet names starting with that text. You can continue to type until only one name is left in the ListBox (you might not have to type the full sheet name to completion for this to happen) and then press the Return key to go to that sheet. But you don't have to keep typing until there is only one sheet name left in the ListBox... at any time, you can press either the down or right arrow and you will find yourself in the ListBox itself where you can continue to use the arrow keys to place the highlight on the sheet name you want, then press Return to go to that sheet. If you find yourself in the TextBox by mistake, just press the left arrow key to put yourself back into the TextBox. You can edit the text in the TextBox and the ListBox will display the sheet names corresponding to the type in text. If you type text that is not the starting text of a sheet name, the ListBox will not display anything (if you mistype a letter so this occurs, just delete the mistyped letter and the ListBox will adjust accordingly). Oh, and you can also just click an entry in the ListBox with your mouse and that will take you to the clicked on sheet name. Okay, now about alternate methods of activating the UserForm (besides always using Alt+F8/Select/Run). Go to any worksheet and press Alt+F8, select CallGoToSheetSelector from the list and then click the Options button. This will bring up a dialog box which lets you assign a shortcut key to your macro. Type a lower case "g" in the indicated field, then click OK and close the dialog box. Now, from any sheet in your workbook, press Ctrl+g and your UserForm will appear, ready to use. I think that is everything. If you have any questions, feel free to post back. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
Thanks to all of you.
I have never worked with User Forms before, so I will take a look of that during the next couple of days. It seems as if it is a good solution. If I don't succeed I think the Hyperlink method can be used. Regards, Kaj Pedersen "KP" <none skrev i en meddelelse b.com... Hi, I need a macro to list all sheets in a workbook and be able to select from the list by double clicking the name of the sheet. (I am already aware of the possibility to right click the symbol left corner in Excel). The code below almost does the job, but I have to write the number corresponding to the sheet and press enter. Can somebody help with the code, so that I can double click the name. Kaj Pedersen myShts = ActiveWorkbook.Sheets.Count For i = 1 To myShts myList = myList & i & " - " & ActiveWorkbook.Sheets(i).Name & " " & vbCr Next i Dim mySht As Single mySht = InputBox("Select sheet to go to." & vbCr & vbCr & myList) Sheets(mySht).Select |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
Hi KP
I have some old code which does what your asking for with one exception, instead of double clicks it puts hyperlinks onto the sheet name for jumping to the sheet. An additional nice feature is the addition of a little shape in each sheet that allows you to jump back. Plus there are routines to remove it all automatically. To be put into a std module: '--------------------------------------------------- Sub Create_Quicklinks() Dim ls As Worksheet Dim c As Range Dim i As Integer Set ls = Worksheets.Add(Befo=Sheets(1)) On Error GoTo delete_old_sheet: ls.Name = "Quicklinks" On Error GoTo 0 Set c = ls.[A1] c(1, 1).Value = "#" c(1, 2).Value = "Worksheet" For i = 2 To Sheets.Count c(i, 1).Value = i c(i, 2).Value = "'" & Sheets(i).Name If Sheets(i).Visible = xlSheetVisible Then ls.Hyperlinks.Add Anchor:=c(i, 2), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=c(i, 2).Value Call Add_BackButton(Sheets(i)) Else c(i, 2).Value = "HIDDEN: " & c(i, 2).Value End If Next i With Range("A1:B1") .Interior.ColorIndex = 23 .Font.Bold = True .Font.ColorIndex = 2 End With With ls.Columns("A:A") .ColumnWidth = 3.3 .HorizontalAlignment = xlCenter End With ls.Columns("B:B").EntireColumn.AutoFit Exit Sub delete_old_sheet: Call DeleteQuicklinks Resume End Sub '------------------------------------------------------- Sub DeleteQuicklinks() Application.DisplayAlerts = False Worksheets("Quicklinks").Delete Call delete_Back_Shapes Application.DisplayAlerts = True End Sub '-------------------------------------------------------- Sub Add_BackButton(r As Object) Dim shp As Shape If r.Type = xlWorksheet Then Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.Range("A1").Left + 5, Top:=r.Range("A1").Top + 7, Width:=30, Height:=25) Else Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.ChartArea.Left + 5, Top:=r.ChartArea.Top + 7, Width:=30, Height:=25) End If With shp With .TextFrame.Characters .Text = "Back" .Font.ColorIndex = 2 .Font.Bold = True .Font.Size = 10 End With With .TextFrame .AutoSize = True .MarginBottom = 0 .MarginLeft = 0 .MarginRight = 2 .MarginTop = 0 End With .Line.Visible = msoFalse .Fill.ForeColor.RGB = RGB(128, 128, 128) .Fill.Transparency = 0.7 .Placement = xlFreeFloating .ControlFormat.PrintObject = False End With r.Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="'Quicklinks'!A1", ScreenTip:="Back to Quicklinks" End Sub '----------------------------------------------------- Sub delete_Back_Shapes() Dim ws As Worksheet Dim shp As Shape For Each ws In Worksheets For Each shp In ws.Shapes If shp.Type = 1 Then If shp.TextFrame.Characters.Text = "Back" Then shp.Delete End If End If Next shp Next ws On Error GoTo 0 End Sub |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
On Oct 10, 2:21*am, minimaster
wrote: Hi KP I have some old code which does what your asking for with one exception, instead of double clicks it puts hyperlinks onto the sheet name for jumping to the sheet. An additional nice feature is the addition of a little shape in each sheet that allows you to jump back. Plus there are routines to remove it all automatically. To be put into a std module: '--------------------------------------------------- Sub Create_Quicklinks() * * Dim ls As Worksheet * * Dim c As Range * * Dim i As Integer * * Set ls = Worksheets.Add(Befo=Sheets(1)) * * On Error GoTo delete_old_sheet: * * ls.Name = "Quicklinks" * * On Error GoTo 0 * * Set c = ls.[A1] * * c(1, 1).Value = "#" * * c(1, 2).Value = "Worksheet" * * For i = 2 To Sheets.Count * * * * c(i, 1).Value = i * * * * c(i, 2).Value = "'" & Sheets(i).Name * * * * If Sheets(i).Visible = xlSheetVisible Then * * * * * * ls.Hyperlinks.Add Anchor:=c(i, 2), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=c(i, 2).Value * * * * * * Call Add_BackButton(Sheets(i)) * * * * Else * * * * * * c(i, 2).Value = "HIDDEN: " & c(i, 2).Value * * * * End If * * Next i * * With Range("A1:B1") * * * * .Interior.ColorIndex = 23 * * * * .Font.Bold = True * * * * .Font.ColorIndex = 2 * * End With * * With ls.Columns("A:A") * * * * .ColumnWidth = 3.3 * * * * .HorizontalAlignment = xlCenter * * End With * * ls.Columns("B:B").EntireColumn.AutoFit * * Exit Sub delete_old_sheet: * * Call DeleteQuicklinks * * Resume End Sub '------------------------------------------------------- Sub DeleteQuicklinks() * * Application.DisplayAlerts = False * * Worksheets("Quicklinks").Delete * * Call delete_Back_Shapes * * Application.DisplayAlerts = True End Sub '-------------------------------------------------------- Sub Add_BackButton(r As Object) * * Dim shp As Shape * * If r.Type = xlWorksheet Then * * * * Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.Range("A1").Left + 5, Top:=r.Range("A1").Top + 7, Width:=30, Height:=25) * * Else * * * * Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.ChartArea.Left + 5, Top:=r.ChartArea.Top + 7, Width:=30, Height:=25) * * End If * * With shp * * * * With .TextFrame.Characters * * * * * * .Text = "Back" * * * * * * .Font.ColorIndex = 2 * * * * * * .Font.Bold = True * * * * * * .Font.Size = 10 * * * * End With * * * * With .TextFrame * * * * * * .AutoSize = True * * * * * * .MarginBottom = 0 * * * * * * .MarginLeft = 0 * * * * * * .MarginRight = 2 * * * * * * .MarginTop = 0 * * * * End With * * * * .Line.Visible = msoFalse * * * * .Fill.ForeColor.RGB = RGB(128, 128, 128) * * * * .Fill.Transparency = 0.7 * * * * .Placement = xlFreeFloating * * * * .ControlFormat.PrintObject = False * * End With * * r.Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="'Quicklinks'!A1", ScreenTip:="Back to Quicklinks" End Sub '----------------------------------------------------- Sub delete_Back_Shapes() * * Dim ws As Worksheet * * Dim shp As Shape * * For Each ws In Worksheets * * * * For Each shp In ws.Shapes * * * * * * If shp.Type = 1 Then * * * * * * * * If shp.TextFrame.Characters.Text = "Back" Then * * * * * * * * * * shp.Delete * * * * * * * * End If * * * * * * End If * * * * Next shp * * Next ws * * On Error GoTo 0 End Sub Put this macro in the sheet module to make a list of the sheets and then double click the cell Option Explicit Sub listsheets() Dim i As Long Columns(1).Clear For i = 1 To Sheets.Count Cells(i, 1).Value = Sheets(i).Name Next i End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim WantedSheet As String WantedSheet = Trim(ActiveCell.Value) If WantedSheet = "" Then Exit Sub On Error Resume Next If Not Sheets(WantedSheet) Is Nothing Then Application.Goto Sheets(WantedSheet).Range("a1") End If End Sub Sub FixIt() Application.EnableEvents = True End Sub |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
I have never worked with User Forms before, so I will take a look of
that during the next couple of days. It seems as if it is a good solution. If you follow the instructions I give, you should have no trouble implementing my solution. Unfortunately, I forgot to post the actual code you are supposed to use with my earlier posting. So that you will have everything altogether in one place, here is the complete posting (instructions and code) that I should have posted in the first place (note the code is at the end of the message). Sorry for any confusion I may have caused. Oh, and one thing I wanted to point out about my suggested solution... it automatically accounts for any changes you make to the workbook... add or delete sheets or change sheet names, whatever, it automatically lists the sheet structure that exists at the time you call it up. Anyway, here is my suggested solution in its entirety... Perhaps this UserForm solution I posted several years ago to an old newsgroup message might work for you. Here is it, presented as I originally posted it (basically, it shows a ListBox of all sheets which you can click directly in (and get taken to the clicked on tab name) or start to type the beginning text of a tab name into a text box which will parse down the list of tab names so you can either click or arrow down to make a selection). My previous post follows.... Okay, here is something I think will meet your needs (don't be put off by the its length, it is really worth the effort)... its a UserForm which lets you type partial entries, pick from a list and takes you to the indicated sheet. I'm going to assume you do not know how to implement a UserForm and talk you through the whole process. Go to the Visual Basic editor (press Alt+F11 from any worksheet). Once there, click Insert/UserForm form the menu bar. You will see a blank form and a window with the caption Toolbox. The Toolbox has controls (TextBox, ListBox, etc.) on it that you will be placing on the blank UserForm (note.. the Toolbox is displayed only when the UserForm has focus). Before we put any controls on the UserForm, let's rename it. On the left side of the VB editor should be a window with the caption "Properties - UserForm1" (if you don't see this, press F4). The first field of the Properties window is labeled (Name) and next to it is the word UserForm1... click the word UserForm1 and type GoToSheetSelector in its place. Next, look down and find the Height and Width properties and set them to these values... Height = 230 Width = 165 These, and other properties for the controls we will be putting on the UserForm, are initial settings to get you started... you will be able to modify them later to suit your own tastes. The rest of the default values for the UserForm should be fine for now. Okay, let's set the UserForm up. There will only be two controls on the UserForm... a TextBox and a ListBox. First, the TextBox. Give the UserForm focus (to make the Toolbox visible) and click on the TextBox icon in the Toolbox (it is one with the lower case letters "ab followed by a vertical bar) to place it. You can use the resize handles to make the TextBox whatever size you want and you can click/drag it to any position you want, but we will use the Properties window to set them to exact values. There are only seven properties I want you to set initially. In the Properties window, find and set the following values... Height = 18 Left = 10 MultiLine = True Top = 10 Width = 140 WordWrap = False The seventh property is actually a dialog box for an object where you will set 3 properties of the object. Click on the field to the right of the Font property and you will see a little button with 3 dots in it... click that button. On the dialog box that appears, set these properties.... Font = Arial Font Style = Bold Size = 10 Okay, that takes care of the TextBox. Next, let's add the ListBox. Click the ListBox icon in the Toolbox (it is a rectangle with 3 horizontal lines on the left and what are supposed to be up/down arrows on the right... if you hover the mouse over the controls, a tooltip will appear with the control's name... you are looking for ListBox) and then click/drag on the UserForm to place it. Set the following properties for it in the Properties window... Height = 165 Left = 10 Top = 38 Width = 140 Okay, that should take care of setting up the UserForm; now let's install the code. Press F7 to bring up the code window for the UserForm (or simply double click anywhere on the UserForm or one of its controls). Delete anything you see in the code window that appears and copy/paste **all** of the marked off code that follows my signature into this code window. Okay, that takes care of the UserForm itself, now we just need a way to call it up. Still in the VB editor, click Insert/Module from the menu bar. Another code window will appear; copy/paste this into it... Sub CallGoToSheetSelector() GoToSheetSelector.Show End Sub Okay, that is pretty much it... the UserForm is usable right now. From any sheet in your workbook, press Alt+F8, select CallGoToSheetSelector from the list and click Run (we can do this differently and I'll explain how in a moment). The UserForm will be displayed showing all sheets in your workbook in the ListBox and the cursor will be in the TextBox. Here is how the UserForm works. Start to type in the name of a sheet in your workbook and the ListBox will show only sheet names starting with that text. You can continue to type until only one name is left in the ListBox (you might not have to type the full sheet name to completion for this to happen) and then press the Return key to go to that sheet. But you don't have to keep typing until there is only one sheet name left in the ListBox... at any time, you can press either the down or right arrow and you will find yourself in the ListBox itself where you can continue to use the arrow keys to place the highlight on the sheet name you want, then press Return to go to that sheet. If you find yourself in the TextBox by mistake, just press the left arrow key to put yourself back into the TextBox. You can edit the text in the TextBox and the ListBox will display the sheet names corresponding to the type in text. If you type text that is not the starting text of a sheet name, the ListBox will not display anything (if you mistype a letter so this occurs, just delete the mistyped letter and the ListBox will adjust accordingly). Oh, and you can also just click an entry in the ListBox with your mouse and that will take you to the clicked on sheet name. Okay, now about alternate methods of activating the UserForm (besides always using Alt+F8/Select/Run). Go to any worksheet and press Alt+F8, select CallGoToSheetSelector from the list and then click the Options button. This will bring up a dialog box which lets you assign a shortcut key to your macro. Type a lower case "g" in the indicated field, then click OK and close the dialog box. Now, from any sheet in your workbook, press Ctrl+g and your UserForm will appear, ready to use. I think that is everything. If you have any questions, feel free to post back. Rick Rothstein (MVP - Excel) ' *************** START OF CODE *************** Dim SheetNames() As String Private Sub UserForm_Initialize() Dim Obj As Object TextBox1.Text = "" TextBox1.EnterKeyBehavior = True ReDim SheetNames(0 To Sheets.Count - 1) For Each Obj In Sheets SheetNames(Obj.Index - 1) = Obj.Name ListBox1.AddItem Obj.Name Next TextBox1.SetFocus End Sub Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _ ByVal Shift As Integer) With TextBox1 If KeyCode = vbKeyLeft Then ListBox1.ListIndex = -1 .SelStart = Len(.Text) .SetFocus ElseIf KeyCode = vbKeyReturn Then If ListBox1.ListCount 0 Then Sheets(ListBox1.Text).Activate Unload Me End If End If End With End Sub Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As _ Integer, ByVal X As Single, ByVal Y As Single) Sheets(ListBox1.List(ListBox1.ListIndex)).Activate Unload Me End Sub Private Sub TextBox1_Change() Dim X As Long Dim Pages() As String Pages = Filter(SheetNames, TextBox1.Text, True, vbTextCompare) If Len(TextBox1.Text) Then If UBound(Pages) -1 Then With ListBox1 .Clear For X = 0 To UBound(Pages) .AddItem Mid$(Pages(X), 1) Next End With Else ListBox1.Clear End If Else ListBox1.Clear For X = 0 To UBound(SheetNames) ListBox1.AddItem Mid$(SheetNames(X), 2) Next End If End Sub Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _ ByVal Shift As Integer) With ListBox1 If KeyCode = vbKeyReturn Then KeyCode = 0 If .ListCount = 0 Then Exit Sub ElseIf .ListCount = 1 Then Sheets(.List(0)).Activate Unload Me Else .SetFocus .Selected(0) = True .ListIndex = 0 End If ElseIf (KeyCode = vbKeyDown Or (KeyCode = vbKeyRight And _ TextBox1.SelStart = Len(TextBox1.Text))) And .ListCount 0 Then .SetFocus .Selected(0) = True .ListIndex = 0 End If End With End Sub ' *************** END OF CODE *************** |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
Hi Don Guillett,
Thank you for your suggestion. I must say that this macro does exactly what I was asking for. It works perfectly. What is the purpose of "Sub FixIt()" When do I have to run that? Kaj Pedersen "Don Guillett" skrev i en meddelelse ... On Oct 10, 2:21 am, minimaster wrote: Hi KP I have some old code which does what your asking for with one exception, instead of double clicks it puts hyperlinks onto the sheet name for jumping to the sheet. An additional nice feature is the addition of a little shape in each sheet that allows you to jump back. Plus there are routines to remove it all automatically. To be put into a std module: '--------------------------------------------------- Sub Create_Quicklinks() Dim ls As Worksheet Dim c As Range Dim i As Integer Set ls = Worksheets.Add(Befo=Sheets(1)) On Error GoTo delete_old_sheet: ls.Name = "Quicklinks" On Error GoTo 0 Set c = ls.[A1] c(1, 1).Value = "#" c(1, 2).Value = "Worksheet" For i = 2 To Sheets.Count c(i, 1).Value = i c(i, 2).Value = "'" & Sheets(i).Name If Sheets(i).Visible = xlSheetVisible Then ls.Hyperlinks.Add Anchor:=c(i, 2), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=c(i, 2).Value Call Add_BackButton(Sheets(i)) Else c(i, 2).Value = "HIDDEN: " & c(i, 2).Value End If Next i With Range("A1:B1") .Interior.ColorIndex = 23 .Font.Bold = True .Font.ColorIndex = 2 End With With ls.Columns("A:A") .ColumnWidth = 3.3 .HorizontalAlignment = xlCenter End With ls.Columns("B:B").EntireColumn.AutoFit Exit Sub delete_old_sheet: Call DeleteQuicklinks Resume End Sub '------------------------------------------------------- Sub DeleteQuicklinks() Application.DisplayAlerts = False Worksheets("Quicklinks").Delete Call delete_Back_Shapes Application.DisplayAlerts = True End Sub '-------------------------------------------------------- Sub Add_BackButton(r As Object) Dim shp As Shape If r.Type = xlWorksheet Then Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.Range("A1").Left + 5, Top:=r.Range("A1").Top + 7, Width:=30, Height:=25) Else Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.ChartArea.Left + 5, Top:=r.ChartArea.Top + 7, Width:=30, Height:=25) End If With shp With .TextFrame.Characters .Text = "Back" .Font.ColorIndex = 2 .Font.Bold = True .Font.Size = 10 End With With .TextFrame .AutoSize = True .MarginBottom = 0 .MarginLeft = 0 .MarginRight = 2 .MarginTop = 0 End With .Line.Visible = msoFalse .Fill.ForeColor.RGB = RGB(128, 128, 128) .Fill.Transparency = 0.7 .Placement = xlFreeFloating .ControlFormat.PrintObject = False End With r.Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="'Quicklinks'!A1", ScreenTip:="Back to Quicklinks" End Sub '----------------------------------------------------- Sub delete_Back_Shapes() Dim ws As Worksheet Dim shp As Shape For Each ws In Worksheets For Each shp In ws.Shapes If shp.Type = 1 Then If shp.TextFrame.Characters.Text = "Back" Then shp.Delete End If End If Next shp Next ws On Error GoTo 0 End Sub Put this macro in the sheet module to make a list of the sheets and then double click the cell Option Explicit Sub listsheets() Dim i As Long Columns(1).Clear For i = 1 To Sheets.Count Cells(i, 1).Value = Sheets(i).Name Next i End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim WantedSheet As String WantedSheet = Trim(ActiveCell.Value) If WantedSheet = "" Then Exit Sub On Error Resume Next If Not Sheets(WantedSheet) Is Nothing Then Application.Goto Sheets(WantedSheet).Range("a1") End If End Sub Sub FixIt() Application.EnableEvents = True End Sub |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
Damn! All I posted were the instructions... I forgot to include the code in
my posting. Here is that code... ' *************** START OF USERFORM CODE *************** Private Sub UserForm_Initialize() Dim Obj As Object TextBox1.Text = "" TextBox1.EnterKeyBehavior = True For Each Obj In Sheets If Obj.Visible Then ListBox1.AddItem Obj.Name Next TextBox1.SetFocus End Sub Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _ ByVal Shift As Integer) With TextBox1 If KeyCode = vbKeyLeft Then ListBox1.ListIndex = -1 .SelStart = Len(.Text) .SetFocus ElseIf KeyCode = vbKeyReturn Then If ListBox1.ListCount 0 Then Sheets(ListBox1.Text).Activate Unload Me End If End If End With End Sub Private Sub ListBox1_MouseUp(ByVal Button As Integer, _ ByVal Shift As Integer, _ ByVal X As Single, ByVal Y As Single) Sheets(ListBox1.List(ListBox1.ListIndex)).Activate Unload Me End Sub Private Sub TextBox1_Change() Dim X As Long ListBox1.Clear For X = 1 To Sheets.Count If InStr(1, Sheets(X).Name, TextBox1.Text, vbTextCompare) = 1 And _ Sheets(X).Visible Then ListBox1.AddItem Sheets(X).Name Next End Sub Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _ ByVal Shift As Integer) With ListBox1 If KeyCode = vbKeyReturn Then KeyCode = 0 If .ListCount = 0 Then Exit Sub ElseIf .ListCount = 1 Then Sheets(.List(0)).Activate Unload Me Else .SetFocus .Selected(0) = True .ListIndex = 0 End If ElseIf (KeyCode = vbKeyDown Or (KeyCode = vbKeyRight And _ TextBox1.SelStart = Len(TextBox1.Text))) And .ListCount 0 Then .SetFocus .Selected(0) = True .ListIndex = 0 End If End With End Sub ' *************** END OF CODE *************** |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
Damn! All I posted were the instructions... I forgot to include the code in
my posting. Here is that code... ' *************** START OF USERFORM CODE *************** Private Sub UserForm_Initialize() Dim Obj As Object TextBox1.Text = "" TextBox1.EnterKeyBehavior = True For Each Obj In Sheets If Obj.Visible Then ListBox1.AddItem Obj.Name Next TextBox1.SetFocus End Sub Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _ ByVal Shift As Integer) With TextBox1 If KeyCode = vbKeyLeft Then ListBox1.ListIndex = -1 .SelStart = Len(.Text) .SetFocus ElseIf KeyCode = vbKeyReturn Then If ListBox1.ListCount 0 Then Sheets(ListBox1.Text).Activate Unload Me End If End If End With End Sub Private Sub ListBox1_MouseUp(ByVal Button As Integer, _ ByVal Shift As Integer, _ ByVal X As Single, ByVal Y As Single) Sheets(ListBox1.List(ListBox1.ListIndex)).Activate Unload Me End Sub Private Sub TextBox1_Change() Dim X As Long ListBox1.Clear For X = 1 To Sheets.Count If InStr(1, Sheets(X).Name, TextBox1.Text, vbTextCompare) = 1 And _ Sheets(X).Visible Then ListBox1.AddItem Sheets(X).Name Next End Sub Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _ ByVal Shift As Integer) With ListBox1 If KeyCode = vbKeyReturn Then KeyCode = 0 If .ListCount = 0 Then Exit Sub ElseIf .ListCount = 1 Then Sheets(.List(0)).Activate Unload Me Else .SetFocus .Selected(0) = True .ListIndex = 0 End If ElseIf (KeyCode = vbKeyDown Or (KeyCode = vbKeyRight And _ TextBox1.SelStart = Len(TextBox1.Text))) And .ListCount 0 Then .SetFocus .Selected(0) = True .ListIndex = 0 End If End With End Sub ' *************** END OF CODE *************** |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
On Oct 10, 10:09*am, "KP" <none wrote:
Hi Don Guillett, Thank you for your suggestion. I must say that this macro does exactly what I was asking for. It works perfectly. What is the purpose of "Sub FixIt()" When do I have to run that? Kaj Pedersen "Don Guillett" skrev i en ... On Oct 10, 2:21 am, minimaster wrote: Hi KP I have some old code which does what your asking for with one exception, instead of double clicks it puts hyperlinks onto the sheet name for jumping to the sheet. An additional nice feature is the addition of a little shape in each sheet that allows you to jump back. Plus there are routines to remove it all automatically. To be put into a std module: '--------------------------------------------------- Sub Create_Quicklinks() Dim ls As Worksheet Dim c As Range Dim i As Integer Set ls = Worksheets.Add(Befo=Sheets(1)) On Error GoTo delete_old_sheet: ls.Name = "Quicklinks" On Error GoTo 0 Set c = ls.[A1] c(1, 1).Value = "#" c(1, 2).Value = "Worksheet" For i = 2 To Sheets.Count c(i, 1).Value = i c(i, 2).Value = "'" & Sheets(i).Name If Sheets(i).Visible = xlSheetVisible Then ls.Hyperlinks.Add Anchor:=c(i, 2), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=c(i, 2).Value Call Add_BackButton(Sheets(i)) Else c(i, 2).Value = "HIDDEN: " & c(i, 2).Value End If Next i With Range("A1:B1") .Interior.ColorIndex = 23 .Font.Bold = True .Font.ColorIndex = 2 End With With ls.Columns("A:A") .ColumnWidth = 3.3 .HorizontalAlignment = xlCenter End With ls.Columns("B:B").EntireColumn.AutoFit Exit Sub delete_old_sheet: Call DeleteQuicklinks Resume End Sub '------------------------------------------------------- Sub DeleteQuicklinks() Application.DisplayAlerts = False Worksheets("Quicklinks").Delete Call delete_Back_Shapes Application.DisplayAlerts = True End Sub '-------------------------------------------------------- Sub Add_BackButton(r As Object) Dim shp As Shape If r.Type = xlWorksheet Then Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.Range("A1").Left + 5, Top:=r.Range("A1").Top + 7, Width:=30, Height:=25) Else Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.ChartArea.Left + 5, Top:=r.ChartArea.Top + 7, Width:=30, Height:=25) End If With shp With .TextFrame.Characters .Text = "Back" .Font.ColorIndex = 2 .Font.Bold = True .Font.Size = 10 End With With .TextFrame .AutoSize = True .MarginBottom = 0 .MarginLeft = 0 .MarginRight = 2 .MarginTop = 0 End With .Line.Visible = msoFalse .Fill.ForeColor.RGB = RGB(128, 128, 128) .Fill.Transparency = 0.7 .Placement = xlFreeFloating .ControlFormat.PrintObject = False End With r.Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="'Quicklinks'!A1", ScreenTip:="Back to Quicklinks" End Sub '----------------------------------------------------- Sub delete_Back_Shapes() Dim ws As Worksheet Dim shp As Shape For Each ws In Worksheets For Each shp In ws.Shapes If shp.Type = 1 Then If shp.TextFrame.Characters.Text = "Back" Then shp.Delete End If End If Next shp Next ws On Error GoTo 0 End Sub Put this macro in the sheet module to *make a list of the sheets and then double click the cell Option Explicit Sub listsheets() Dim i As Long Columns(1).Clear For i = 1 To Sheets.Count Cells(i, 1).Value = Sheets(i).Name Next i End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) *Dim WantedSheet As String * *WantedSheet = Trim(ActiveCell.Value) * *If WantedSheet = "" Then Exit Sub * *On Error Resume Next * *If Not Sheets(WantedSheet) Is Nothing Then * *Application.Goto Sheets(WantedSheet).Range("a1") * *End If End Sub Sub FixIt() Application.EnableEvents = True End Sub It's just there in case the event codes stop working. You shouldn't need it. |
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
On Oct 10, 11:52*am, Don Guillett wrote:
On Oct 10, 10:09*am, "KP" <none wrote: Hi Don Guillett, Thank you for your suggestion. I must say that this macro does exactly what I was asking for. It works perfectly. What is the purpose of "Sub FixIt()" When do I have to run that? Kaj Pedersen "Don Guillett" skrev i en ... On Oct 10, 2:21 am, minimaster wrote: Hi KP I have some old code which does what your asking for with one exception, instead of double clicks it puts hyperlinks onto the sheet name for jumping to the sheet. An additional nice feature is the addition of a little shape in each sheet that allows you to jump back.. Plus there are routines to remove it all automatically. To be put into a std module: '--------------------------------------------------- Sub Create_Quicklinks() Dim ls As Worksheet Dim c As Range Dim i As Integer Set ls = Worksheets.Add(Befo=Sheets(1)) On Error GoTo delete_old_sheet: ls.Name = "Quicklinks" On Error GoTo 0 Set c = ls.[A1] c(1, 1).Value = "#" c(1, 2).Value = "Worksheet" For i = 2 To Sheets.Count c(i, 1).Value = i c(i, 2).Value = "'" & Sheets(i).Name If Sheets(i).Visible = xlSheetVisible Then ls.Hyperlinks.Add Anchor:=c(i, 2), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=c(i, 2).Value Call Add_BackButton(Sheets(i)) Else c(i, 2).Value = "HIDDEN: " & c(i, 2).Value End If Next i With Range("A1:B1") .Interior.ColorIndex = 23 .Font.Bold = True .Font.ColorIndex = 2 End With With ls.Columns("A:A") .ColumnWidth = 3.3 .HorizontalAlignment = xlCenter End With ls.Columns("B:B").EntireColumn.AutoFit Exit Sub delete_old_sheet: Call DeleteQuicklinks Resume End Sub '------------------------------------------------------- Sub DeleteQuicklinks() Application.DisplayAlerts = False Worksheets("Quicklinks").Delete Call delete_Back_Shapes Application.DisplayAlerts = True End Sub '-------------------------------------------------------- Sub Add_BackButton(r As Object) Dim shp As Shape If r.Type = xlWorksheet Then Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.Range("A1").Left + 5, Top:=r.Range("A1").Top + 7, Width:=30, Height:=25) Else Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.ChartArea.Left + 5, Top:=r.ChartArea.Top + 7, Width:=30, Height:=25) End If With shp With .TextFrame.Characters .Text = "Back" .Font.ColorIndex = 2 .Font.Bold = True .Font.Size = 10 End With With .TextFrame .AutoSize = True .MarginBottom = 0 .MarginLeft = 0 .MarginRight = 2 .MarginTop = 0 End With .Line.Visible = msoFalse .Fill.ForeColor.RGB = RGB(128, 128, 128) .Fill.Transparency = 0.7 .Placement = xlFreeFloating .ControlFormat.PrintObject = False End With r.Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="'Quicklinks'!A1", ScreenTip:="Back to Quicklinks" End Sub '----------------------------------------------------- Sub delete_Back_Shapes() Dim ws As Worksheet Dim shp As Shape For Each ws In Worksheets For Each shp In ws.Shapes If shp.Type = 1 Then If shp.TextFrame.Characters.Text = "Back" Then shp.Delete End If End If Next shp Next ws On Error GoTo 0 End Sub Put this macro in the sheet module to *make a list of the sheets and then double click the cell Option Explicit Sub listsheets() Dim i As Long Columns(1).Clear For i = 1 To Sheets.Count Cells(i, 1).Value = Sheets(i).Name Next i End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) *Dim WantedSheet As String * *WantedSheet = Trim(ActiveCell.Value) * *If WantedSheet = "" Then Exit Sub * *On Error Resume Next * *If Not Sheets(WantedSheet) Is Nothing Then * *Application.Goto Sheets(WantedSheet).Range("a1") * *End If End Sub Sub FixIt() Application.EnableEvents = True End Sub It's just there in case the event codes stop working. You shouldn't need it. |
#15
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
Hi,
I have tried your code and it works but there are some problems: If the name of the sheet is a number or the name of the sheet has many characters the macro fails. --------------------------------------------- Sub Add_BackButton(r As object) ..AutoSize = True (Macro stops and this text turns yellow) I have tried to set it to False without success. Does someone has a solution to this. Regards, Kaj Pedersen "minimaster" skrev i en meddelelse ... Hi KP I have some old code which does what your asking for with one exception, instead of double clicks it puts hyperlinks onto the sheet name for jumping to the sheet. An additional nice feature is the addition of a little shape in each sheet that allows you to jump back. Plus there are routines to remove it all automatically. To be put into a std module: '--------------------------------------------------- Sub Create_Quicklinks() Dim ls As Worksheet Dim c As Range Dim i As Integer Set ls = Worksheets.Add(Befo=Sheets(1)) On Error GoTo delete_old_sheet: ls.Name = "Quicklinks" On Error GoTo 0 Set c = ls.[A1] c(1, 1).Value = "#" c(1, 2).Value = "Worksheet" For i = 2 To Sheets.Count c(i, 1).Value = i c(i, 2).Value = "'" & Sheets(i).Name If Sheets(i).Visible = xlSheetVisible Then ls.Hyperlinks.Add Anchor:=c(i, 2), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=c(i, 2).Value Call Add_BackButton(Sheets(i)) Else c(i, 2).Value = "HIDDEN: " & c(i, 2).Value End If Next i With Range("A1:B1") .Interior.ColorIndex = 23 .Font.Bold = True .Font.ColorIndex = 2 End With With ls.Columns("A:A") .ColumnWidth = 3.3 .HorizontalAlignment = xlCenter End With ls.Columns("B:B").EntireColumn.AutoFit Exit Sub delete_old_sheet: Call DeleteQuicklinks Resume End Sub '------------------------------------------------------- Sub DeleteQuicklinks() Application.DisplayAlerts = False Worksheets("Quicklinks").Delete Call delete_Back_Shapes Application.DisplayAlerts = True End Sub '-------------------------------------------------------- Sub Add_BackButton(r As Object) Dim shp As Shape If r.Type = xlWorksheet Then Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.Range("A1").Left + 5, Top:=r.Range("A1").Top + 7, Width:=30, Height:=25) Else Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.ChartArea.Left + 5, Top:=r.ChartArea.Top + 7, Width:=30, Height:=25) End If With shp With .TextFrame.Characters .Text = "Back" .Font.ColorIndex = 2 .Font.Bold = True .Font.Size = 10 End With With .TextFrame .AutoSize = True .MarginBottom = 0 .MarginLeft = 0 .MarginRight = 2 .MarginTop = 0 End With .Line.Visible = msoFalse .Fill.ForeColor.RGB = RGB(128, 128, 128) .Fill.Transparency = 0.7 .Placement = xlFreeFloating .ControlFormat.PrintObject = False End With r.Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="'Quicklinks'!A1", ScreenTip:="Back to Quicklinks" End Sub '----------------------------------------------------- Sub delete_Back_Shapes() Dim ws As Worksheet Dim shp As Shape For Each ws In Worksheets For Each shp In ws.Shapes If shp.Type = 1 Then If shp.TextFrame.Characters.Text = "Back" Then shp.Delete End If End If Next shp Next ws On Error GoTo 0 End Sub |
#16
Posted to microsoft.public.excel.programming
|
|||
|
|||
Re (minimaster): List all sheets in the work book and select by double click
Hi minimaster,
I have tried your code and it works but there are some problems: If the name of the sheet is a number or the name of the sheet has many characters the macro fails. --------------------------------------------- Sub Add_BackButton(r As object) ..AutoSize = True (Macro stops and this text turns yellow) I have tried to set it to False without success. Does someone has a solution to this. Regards, Kaj Pedersen "minimaster" skrev i en meddelelse ... Hi KP I have some old code which does what your asking for with one exception, instead of double clicks it puts hyperlinks onto the sheet name for jumping to the sheet. An additional nice feature is the addition of a little shape in each sheet that allows you to jump back. Plus there are routines to remove it all automatically. To be put into a std module: '--------------------------------------------------- Sub Create_Quicklinks() Dim ls As Worksheet Dim c As Range Dim i As Integer Set ls = Worksheets.Add(Befo=Sheets(1)) On Error GoTo delete_old_sheet: ls.Name = "Quicklinks" On Error GoTo 0 Set c = ls.[A1] c(1, 1).Value = "#" c(1, 2).Value = "Worksheet" For i = 2 To Sheets.Count c(i, 1).Value = i c(i, 2).Value = "'" & Sheets(i).Name If Sheets(i).Visible = xlSheetVisible Then ls.Hyperlinks.Add Anchor:=c(i, 2), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=c(i, 2).Value Call Add_BackButton(Sheets(i)) Else c(i, 2).Value = "HIDDEN: " & c(i, 2).Value End If Next i With Range("A1:B1") .Interior.ColorIndex = 23 .Font.Bold = True .Font.ColorIndex = 2 End With With ls.Columns("A:A") .ColumnWidth = 3.3 .HorizontalAlignment = xlCenter End With ls.Columns("B:B").EntireColumn.AutoFit Exit Sub delete_old_sheet: Call DeleteQuicklinks Resume End Sub '------------------------------------------------------- Sub DeleteQuicklinks() Application.DisplayAlerts = False Worksheets("Quicklinks").Delete Call delete_Back_Shapes Application.DisplayAlerts = True End Sub '-------------------------------------------------------- Sub Add_BackButton(r As Object) Dim shp As Shape If r.Type = xlWorksheet Then Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.Range("A1").Left + 5, Top:=r.Range("A1").Top + 7, Width:=30, Height:=25) Else Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.ChartArea.Left + 5, Top:=r.ChartArea.Top + 7, Width:=30, Height:=25) End If With shp With .TextFrame.Characters .Text = "Back" .Font.ColorIndex = 2 .Font.Bold = True .Font.Size = 10 End With With .TextFrame .AutoSize = True .MarginBottom = 0 .MarginLeft = 0 .MarginRight = 2 .MarginTop = 0 End With .Line.Visible = msoFalse .Fill.ForeColor.RGB = RGB(128, 128, 128) .Fill.Transparency = 0.7 .Placement = xlFreeFloating .ControlFormat.PrintObject = False End With r.Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="'Quicklinks'!A1", ScreenTip:="Back to Quicklinks" End Sub '----------------------------------------------------- Sub delete_Back_Shapes() Dim ws As Worksheet Dim shp As Shape For Each ws In Worksheets For Each shp In ws.Shapes If shp.Type = 1 Then If shp.TextFrame.Characters.Text = "Back" Then shp.Delete End If End If Next shp Next ws On Error GoTo 0 End Sub |
#17
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
Hi minimaster
I have tried your code and it works but there are some problems: If the name of the sheet is a number or the name of the sheet has many characters the macro fails. --------------------------------------------- Sub Add_BackButton(r As object) ..AutoSize = True (Macro stops and this text turns yellow) I have tried to set it to False without success. Does someone has a solution to this. Regards, Kaj Pedersen "minimaster" skrev i en meddelelse ... Hi KP I have some old code which does what your asking for with one exception, instead of double clicks it puts hyperlinks onto the sheet name for jumping to the sheet. An additional nice feature is the addition of a little shape in each sheet that allows you to jump back. Plus there are routines to remove it all automatically. To be put into a std module: '--------------------------------------------------- Sub Create_Quicklinks() Dim ls As Worksheet Dim c As Range Dim i As Integer Set ls = Worksheets.Add(Befo=Sheets(1)) On Error GoTo delete_old_sheet: ls.Name = "Quicklinks" On Error GoTo 0 Set c = ls.[A1] c(1, 1).Value = "#" c(1, 2).Value = "Worksheet" For i = 2 To Sheets.Count c(i, 1).Value = i c(i, 2).Value = "'" & Sheets(i).Name If Sheets(i).Visible = xlSheetVisible Then ls.Hyperlinks.Add Anchor:=c(i, 2), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=c(i, 2).Value Call Add_BackButton(Sheets(i)) Else c(i, 2).Value = "HIDDEN: " & c(i, 2).Value End If Next i With Range("A1:B1") .Interior.ColorIndex = 23 .Font.Bold = True .Font.ColorIndex = 2 End With With ls.Columns("A:A") .ColumnWidth = 3.3 .HorizontalAlignment = xlCenter End With ls.Columns("B:B").EntireColumn.AutoFit Exit Sub delete_old_sheet: Call DeleteQuicklinks Resume End Sub '------------------------------------------------------- Sub DeleteQuicklinks() Application.DisplayAlerts = False Worksheets("Quicklinks").Delete Call delete_Back_Shapes Application.DisplayAlerts = True End Sub '-------------------------------------------------------- Sub Add_BackButton(r As Object) Dim shp As Shape If r.Type = xlWorksheet Then Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.Range("A1").Left + 5, Top:=r.Range("A1").Top + 7, Width:=30, Height:=25) Else Set shp = r.Shapes.AddShape(Type:=msoShapeLeftArrow, Left:=r.ChartArea.Left + 5, Top:=r.ChartArea.Top + 7, Width:=30, Height:=25) End If With shp With .TextFrame.Characters .Text = "Back" .Font.ColorIndex = 2 .Font.Bold = True .Font.Size = 10 End With With .TextFrame .AutoSize = True .MarginBottom = 0 .MarginLeft = 0 .MarginRight = 2 .MarginTop = 0 End With .Line.Visible = msoFalse .Fill.ForeColor.RGB = RGB(128, 128, 128) .Fill.Transparency = 0.7 .Placement = xlFreeFloating .ControlFormat.PrintObject = False End With r.Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:="'Quicklinks'!A1", ScreenTip:="Back to Quicklinks" End Sub '----------------------------------------------------- Sub delete_Back_Shapes() Dim ws As Worksheet Dim shp As Shape For Each ws In Worksheets For Each shp In ws.Shapes If shp.Type = 1 Then If shp.TextFrame.Characters.Text = "Back" Then shp.Delete End If End If Next shp Next ws On Error GoTo 0 End Sub |
#18
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
Hi Rick,
I am glad that you introduced me to UserForms and I must say that your instructions were very understandable and easy to follow. I succeeded in setting it all up, so that I can call the window showing all my sheets. I think this is the method I prefer to implement. Thanks again. Best regards, Kaj Pedersen "Rick Rothstein" skrev i en meddelelse ... Damn! All I posted were the instructions... I forgot to include the code in my posting. Here is that code... ' *************** START OF USERFORM CODE *************** Private Sub UserForm_Initialize() Dim Obj As Object TextBox1.Text = "" TextBox1.EnterKeyBehavior = True For Each Obj In Sheets If Obj.Visible Then ListBox1.AddItem Obj.Name Next TextBox1.SetFocus End Sub Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _ ByVal Shift As Integer) With TextBox1 If KeyCode = vbKeyLeft Then ListBox1.ListIndex = -1 .SelStart = Len(.Text) .SetFocus ElseIf KeyCode = vbKeyReturn Then If ListBox1.ListCount 0 Then Sheets(ListBox1.Text).Activate Unload Me End If End If End With End Sub Private Sub ListBox1_MouseUp(ByVal Button As Integer, _ ByVal Shift As Integer, _ ByVal X As Single, ByVal Y As Single) Sheets(ListBox1.List(ListBox1.ListIndex)).Activate Unload Me End Sub Private Sub TextBox1_Change() Dim X As Long ListBox1.Clear For X = 1 To Sheets.Count If InStr(1, Sheets(X).Name, TextBox1.Text, vbTextCompare) = 1 And _ Sheets(X).Visible Then ListBox1.AddItem Sheets(X).Name Next End Sub Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _ ByVal Shift As Integer) With ListBox1 If KeyCode = vbKeyReturn Then KeyCode = 0 If .ListCount = 0 Then Exit Sub ElseIf .ListCount = 1 Then Sheets(.List(0)).Activate Unload Me Else .SetFocus .Selected(0) = True .ListIndex = 0 End If ElseIf (KeyCode = vbKeyDown Or (KeyCode = vbKeyRight And _ TextBox1.SelStart = Len(TextBox1.Text))) And .ListCount 0 Then .SetFocus .Selected(0) = True .ListIndex = 0 End If End With End Sub ' *************** END OF CODE *************** |
#19
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
I am glad that you introduced me to UserForms and I must say
that your instructions were very understandable and easy to follow. I succeeded in setting it all up, so that I can call the window showing all my sheets. I think this is the method I prefer to implement. Thanks again. You are quite welcome. If you think you will want to use this idea on other projects, you may want to do what I did... install the code on a clean workbook (or just take the one you have and delete all data and any VB code (other than the code I gave you of course) and then save the workbook as an Excel Template. That way, whenever you start a new workbook, just pick that template instead of a blank workbook and the functionality will be immediately available. If this is a new concept to you, write back with your Excel version number and I'll try to provide instructions to you for that version. Rick Rothstein (MVP - Excel) |
#20
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
Hi KP,
If you have problems with sheets that have numbers then you might have had problems copying the code properly from my posting. In the code there is a line c(i, 2).Value = "'" & Sheets(i).Name The single quote in front of the sheet name is important so sheet names that are numbers are correctly recognized as text when listing them for hyperlink purposes. Regarding the error at line .Autosize = True I need more information. I need to know your Excel version and the error message. May be this be a code copy and paste problem too ? This board intro's line breaks which are not there in the real code. These extra line feeds must be removed when doing a copy and paste from this forum. |
#21
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
Hi minimaster,
I was fully aware of the line breaks, so this was not the problem. Also the line: c(i, 2).Value = "'" & Sheets(i).Name was correct. I found out that for some reason one of the "Back" bottons was not removed when running "Delete QuickLinks" As soon as i deleted this sheet the problem was fixed. Now sheets named by number and everything else are showed as QuickLinks and I must say that the "Back" button is a nice feature. Thank you for your help in this case. Regards, Kaj Pedersen "minimaster" skrev i en meddelelse ... Hi KP, If you have problems with sheets that have numbers then you might have had problems copying the code properly from my posting. In the code there is a line c(i, 2).Value = "'" & Sheets(i).Name The single quote in front of the sheet name is important so sheet names that are numbers are correctly recognized as text when listing them for hyperlink purposes. Regarding the error at line .Autosize = True I need more information. I need to know your Excel version and the error message. May be this be a code copy and paste problem too ? This board intro's line breaks which are not there in the real code. These extra line feeds must be removed when doing a copy and paste from this forum. |
#22
Posted to microsoft.public.excel.programming
|
|||
|
|||
List all sheets in the work book and select by double click
A good idea.
I already know how to make templates :-) Kaj Pedersen "Rick Rothstein" skrev i en meddelelse ... I am glad that you introduced me to UserForms and I must say that your instructions were very understandable and easy to follow. I succeeded in setting it all up, so that I can call the window showing all my sheets. I think this is the method I prefer to implement. Thanks again. You are quite welcome. If you think you will want to use this idea on other projects, you may want to do what I did... install the code on a clean workbook (or just take the one you have and delete all data and any VB code (other than the code I gave you of course) and then save the workbook as an Excel Template. That way, whenever you start a new workbook, just pick that template instead of a blank workbook and the functionality will be immediately available. If this is a new concept to you, write back with your Excel version number and I'll try to provide instructions to you for that version. Rick Rothstein (MVP - Excel) |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Formula in Excel does not work until after I double-click inside c | Excel Discussion (Misc queries) | |||
Mouse double-click to select listbox item and run userform | Excel Programming | |||
Function does not work unless I double click the cell and push ent | Excel Discussion (Misc queries) | |||
Double click xlsname in explorer doesn't work. | New Users to Excel | |||
Double Click for all Sheets | Excel Programming |