please help me to adapt this code..

[robhargreaves]

I am using the code below and it all works just as I need for printing.

I would like to use exactly the same popup dialogue box and most of the same code but instead of it printing I need it to simply go to the selected page.

I can see the problem of not being able to view more than one at a time so may have to change the checkbox to a radio buttons to make sure only one sheet is selected.

Thanks in advance.

Rob

--Code__

Sub ViewSheets()

Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet
Dim cb As CheckBox
Application.ScreenUpdating = False

' Check for protected workbook
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If

' Add a temporary dialog sheet
Set CurrentSheet = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add

SheetCount = 0

' Add the checkboxes
TopPos = 40
For i = 1 To ActiveWorkbook.Sheets.Count
Set CurrentSheet = ActiveWorkbook.Sheets(i)
' Skip empty sheets and hidden sheets
If CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i

' Move the OK and Cancel buttons
PrintDlg.Buttons.Left = 240

' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 230
.Caption = "Select sheets to print"
End With

' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront

' Display the dialog box
CurrentSheet.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
For Each cb In PrintDlg.CheckBoxes
If cb.Value = xlOn Then
Sheets(cb.Caption).Activate
ActiveSheet.PrintOut , (1)
' ActiveSheet.PrintPreview 'for debugging
End If
Next cb
End If
Else
MsgBox "All worksheets are empty."
End If

' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete

' Reactivate original sheet
Application.Goto Reference:=Worksheets("Menu").Range("A1")

End Sub

 

[KenWright]

That seems to be reinventing the wheel somewhat. If you simply right click on the arrows at the bottom left of your spreadsheet you will get exactly the same functionality, but far more efficiently as it is already built in. Hitting the 'more sheets' option gives you a scrollable list if you have more sheets than the window typically displays.

Addendum

When you post code, it really helps people if you use some sort of indenture, and then use the Code tags when posting. Compare your posted version with this version.

Sub ViewSheets()

    Dim i      As Integer
    Dim TopPos As Integer
    Dim SheetCount As Integer
    Dim PrintDlg As DialogSheet
    Dim CurrentSheet
    Dim cb     As CheckBox
    Application.ScreenUpdating = False

    ' Check for protected workbook
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Workbook is protected.", vbCritical
        Exit Sub
    End If

    ' Add a temporary dialog sheet
    Set CurrentSheet = ActiveSheet
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add

    SheetCount = 0

    ' Add the checkboxes
    TopPos = 40
    For i = 1 To ActiveWorkbook.Sheets.Count
        Set CurrentSheet = ActiveWorkbook.Sheets(i)
        ' Skip empty sheets and hidden sheets
        If CurrentSheet.Visible Then
            SheetCount = SheetCount + 1
            PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
            PrintDlg.CheckBoxes(SheetCount).Text = _
            CurrentSheet.Name
            TopPos = TopPos + 13
        End If
    Next i

    ' Move the OK and Cancel buttons
    PrintDlg.Buttons.Left = 240

    ' Set dialog height, width, and caption
    With PrintDlg.DialogFrame
        .Height = Application.Max _
                  (68, PrintDlg.DialogFrame.Top + TopPos - 34)
        .Width = 230
        .Caption = "Select sheets to print"
    End With

    ' Change tab order of OK and Cancel buttons
    ' so the 1st option button will have the focus
    PrintDlg.Buttons("Button 2").BringToFront
    PrintDlg.Buttons("Button 3").BringToFront

    ' Display the dialog box
    CurrentSheet.Activate
    Application.ScreenUpdating = True
    If SheetCount <> 0 Then
        If PrintDlg.Show Then
            For Each cb In PrintDlg.CheckBoxes
                If cb.Value = xlOn Then
                    Sheets(cb.Caption).Activate
                    ActiveSheet.PrintOut , (1)
                    ' ActiveSheet.PrintPreview 'for debugging
                End If
            Next cb
        End If
    Else
        MsgBox "All worksheets are empty."
    End If

    ' Delete temporary dialog sheet (without a warning)
    Application.DisplayAlerts = False
    PrintDlg.Delete

    ' Reactivate original sheet
    Application.Goto Reference:=Worksheets("Menu").Range("A1")

End Sub

I was able to produce that indenture in literally less than 1 second using Stephen bullens free addin 'Smart Indenter', available from

http://www.oaltd.co.uk/Indenter/Default.htm