View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Jim Thomlinson[_4_] Jim Thomlinson[_4_] is offline
external usenet poster
 
Posts: 1,119
Default InputBox to capture user selected sheet names?

I changed Bob's code just a tad to have it return a collection of the sheets
selected (I hope you don't mind Bob but I am going to borrow this code. Very
handy.) Just one question Bob. It seems to have the side effect of selecting
the last sheet in the book. What is causing that?

'----------------------------------------------------------------
Function BrowseSheets() As Collection
'----------------------------------------------------------------
Const nPerColumn As Long = 35 'number of items per column
Const nWidth As Long = 7 'width of each letter
Const nHeight As Long = 18 'height of each row
Const sID As String = "___SheetSelect" 'name of dialog sheet
Const kCaption As String = " Select sheet to goto"
'dialog caption
Dim i As Long
Dim TopPos As Long
Dim iBooks As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim iLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox
Dim colSheets As Collection

Application.ScreenUpdating = False

If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Function
End If

On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(sID).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set thisDlg = ActiveWorkbook.DialogSheets.Add

With thisDlg

.Name = sID
.Visible = xlSheetHidden

'sets variables for positioning on dialog
iBooks = 0
cCols = 0
cMaxLetters = 0
iLeft = 78
TopPos = 40

For i = 1 To ActiveWorkbook.Worksheets.Count

If i Mod nPerColumn = 1 Then
cCols = cCols + 1
TopPos = 40
iLeft = iLeft + (cMaxLetters * nWidth)
cMaxLetters = 0
End If

Set CurrentSheet = ActiveWorkbook.Worksheets(i)
cLetters = Len(CurrentSheet.Name)
If cLetters cMaxLetters Then
cMaxLetters = cLetters
End If

iBooks = iBooks + 1
.CheckBoxes.Add iLeft, TopPos, cLetters * nWidth, 16.5
.CheckBoxes(iBooks).Text = _
ActiveWorkbook.Worksheets(iBooks).Name
TopPos = TopPos + 13

Next i

.Buttons.Left = iLeft + (cMaxLetters * nWidth) + 24

CurrentSheet.Activate

With .DialogFrame
.Height = Application.Max(68, _
Application.Min(iBooks, nPerColumn) * nHeight + 10)
.Width = iLeft + (cMaxLetters * nWidth) + 24
.Caption = kCaption
End With

.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront

Application.ScreenUpdating = True
If .Show Then
For Each cb In thisDlg.CheckBoxes
If cb.Value = xlOn Then
If colSheets Is Nothing Then Set colSheets = New
Collection
colSheets.Add Sheets(cb.Caption), cb.Caption
Set BrowseSheets = colSheets
End If
Next cb
Else
MsgBox "Nothing selected"
End If

Application.DisplayAlerts = False
.Delete

End With

End Function
'----------------------------------------------------------------

Private Sub TestBobsNeatCode()
Dim col As Collection
Dim wks As Worksheet

On Error Resume Next
Set col = BrowseSheets
On Error GoTo 0

If Not col Is Nothing Then
For Each wks In col
MsgBox wks.Name
Next wks
End If
End Sub

--
HTH...

Jim Thomlinson


"Bob Phillips" wrote:

Here is an alternative method

Sub TestBrowseSheets()
MsgBox BrowseSheets
End Sub

'----------------------------------------------------------------
Function BrowseSheets()
'----------------------------------------------------------------
Const nPerColumn As Long = 35 'number of items per column
Const nWidth As Long = 7 'width of each letter
Const nHeight As Long = 18 'height of each row
Const sID As String = "___SheetSelect" 'name of dialog sheet
Const kCaption As String = " Select sheet to goto"
'dialog caption
Dim i As Long
Dim TopPos As Long
Dim iBooks As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim iLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox

Application.ScreenUpdating = False

If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Function
End If

On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(sID).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set thisDlg = ActiveWorkbook.DialogSheets.Add

With thisDlg

.Name = sID
.Visible = xlSheetHidden

'sets variables for positioning on dialog
iBooks = 0
cCols = 0
cMaxLetters = 0
iLeft = 78
TopPos = 40

For i = 1 To ActiveWorkbook.Worksheets.Count

If i Mod nPerColumn = 1 Then
cCols = cCols + 1
TopPos = 40
iLeft = iLeft + (cMaxLetters * nWidth)
cMaxLetters = 0
End If

Set CurrentSheet = ActiveWorkbook.Worksheets(i)
cLetters = Len(CurrentSheet.Name)
If cLetters cMaxLetters Then
cMaxLetters = cLetters
End If

iBooks = iBooks + 1
.CheckBoxes.Add iLeft, TopPos, cLetters * nWidth, 16.5
.CheckBoxes(iBooks).Text = _
ActiveWorkbook.Worksheets(iBooks).Name
TopPos = TopPos + 13

Next i

.Buttons.Left = iLeft + (cMaxLetters * nWidth) + 24

CurrentSheet.Activate

With .DialogFrame
.Height = Application.Max(68, _
Application.Min(iBooks, nPerColumn) * nHeight + 10)
.Width = iLeft + (cMaxLetters * nWidth) + 24
.Caption = kCaption
End With

.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront

Application.ScreenUpdating = True
If .Show Then
For Each cb In thisDlg.CheckBoxes
If cb.Value = xlOn Then
BrowseSheets = cb.Caption
Exit For
End If
Next cb
Else
MsgBox "Nothing selected"
End If

Application.DisplayAlerts = False
.Delete

End With

End Function
'----------------------------------------------------------------




--

HTH

RP
(remove nothere from the email address if mailing direct)


"quartz" wrote in message
...
I am using Office 2003 on Windows XP.

Rather than going thru the hassle of designing and coding a userform for
this purpose, I would like to know if it is possible to just use a regular
"InputBox" in the following manner:

After display, allow the user to click on various sheet tabs and have the
sheet tab names captured and returned in a string variable in the code.

1) Can this be done?

2) Could you please post example code that would function in this way?

Thanks much in advance.