Hi everyone!

I need to add on to the following code which currently makes a pop up
box for all sheets in my workbook except for the first four. What I
want added is an additional clickable option on this pop up window that
will say "outage query". Once clicking on this, it will then open
another pop up in which the user will click on one of 4 available areas.
After clicking the area, the user will then be able to entry a date or
range of dates in which it will search the appropriate area (which is
one of the 4 first sheets in the workbook) for entries with that date
and list then.

Is this at all possible? Any help will be greatly appreciated!

Here is my current code:

rivate Sub Workbook_Open()
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim ob As OptionButton

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 = 5 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Skip empty sheets sheets
SheetCount = SheetCount + 1
PrintDlg.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(SheetCount).Text = _
CurrentSheet.Name
If Worksheets(i).Visible < xlSheetVisible Then
PrintDlg.OptionButtons(SheetCount).Value = True
End If
TopPos = TopPos + 13
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 = "What would you like to do today?"
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 ob In PrintDlg.OptionButtons
If ob.Value = xlOn Then
Sheets(ob.Caption).Activate
Exit For
End If
Next ob
End If
Else
MsgBox "All worksheets are empty."
End If

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

End Sub






Thanks for reading!

Kris Taylor

*** Sent via Devdex http://www.devdex.com ***
Don't just participate in USENET...get rewarded for it!

Option Explicit


Dim fCancel As Boolean

'---------------------------------------------------------------------
Private Sub Workbook_Open()
'---------------------------------------------------------------------
Const sTitle As String = "What would you like to do today?"
Const sMsgTitle As String = "Sheet Goto"
Const sID As String = "___SheetGoto"
Dim dlgThis As DialogSheet
Dim oThis As Workbook
Dim CurrentSheet As Worksheet
Dim oCtl As OptionButton
Dim SheetCount As Long
Dim nBinary As Long
Dim cMaxLetters As Long
Dim i As Long
Dim j As Long
Dim TopPos As Long

Application.ScreenUpdating = False

Set oThis = ActiveWorkbook

If oThis.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical, sMsgTitle
Exit Sub
End If

Set CurrentSheet = ActiveSheet
Set dlgThis = oThis.DialogSheets.Add
With dlgThis

.Name = sID
.Visible = xlSheetHidden

SheetCount = 0

'Add the option buttons
TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
'calculate length of longest sheet name
If Len(oThis.Sheets(i).Name) cMaxLetters Then
cMaxLetters = Len(oThis.Sheets(i).Name)
End If
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
'Skip empty sheets sheets
SheetCount = SheetCount + 1
dlgThis.OptionButtons.Add 78, TopPos, 150, 16.5
dlgThis.OptionButtons(SheetCount).Text = _
CurrentSheet.Name
If Worksheets(i).Visible < xlSheetVisible Then
dlgThis.OptionButtons(SheetCount).Value = True
End If
TopPos = TopPos + 13
Next i

'position the optionbuttons and buttons according to
' length of longest sheet name
.OptionButtons.Left = 78
.Buttons.Left = 78 + (cMaxLetters * 4) + 10 + 24 + 8

'adjust dialog to align with number of controls and
' length of longest sheet name
With .DialogFrame
.Height = Application.Max(84, .Top + TopPos - 34)
.Width = 78 + (cMaxLetters * 4) + 10 + 24 + 8 - 10
.Caption = sTitle
End With

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

.Buttons("Button 3").OnAction = "CancelButton"

.Buttons.Add 78 + (cMaxLetters * 4) + 10 + 24 + 8, 84, 58, 16
With .Buttons("Button " & .Shapes.Count)
.Caption = "outage query"
.OnAction = "QueryButton"
End With

'Display the dialog box
CurrentSheet.Activate
Application.ScreenUpdating = True
If SheetCount < 0 Then
If dlgThis.Show Then
For Each oCtl In dlgThis.OptionButtons
If oCtl.Value = xlOn Then
Sheets(oCtl.Caption).Activate
Exit For
End If
Next oCtl
End If
Else
MsgBox "All worksheets are empty."
End If

Application.DisplayAlerts = False
.delete

End With

End Sub

Private Sub CancelButton()
fCancel = True
End Sub

Private Sub QueryButton()
'... add your code here
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Kris Taylor" wrote in message
...
Hi everyone!

I need to add on to the following code which currently makes a pop up
box for all sheets in my workbook except for the first four. What I
want added is an additional clickable option on this pop up window that
will say "outage query". Once clicking on this, it will then open
another pop up in which the user will click on one of 4 available areas.
After clicking the area, the user will then be able to entry a date or
range of dates in which it will search the appropriate area (which is
one of the 4 first sheets in the workbook) for entries with that date
and list then.

Is this at all possible? Any help will be greatly appreciated!

Here is my current code:

rivate Sub Workbook_Open()
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim ob As OptionButton

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 = 5 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Skip empty sheets sheets
SheetCount = SheetCount + 1
PrintDlg.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(SheetCount).Text = _
CurrentSheet.Name
If Worksheets(i).Visible < xlSheetVisible Then
PrintDlg.OptionButtons(SheetCount).Value = True
End If
TopPos = TopPos + 13
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 = "What would you like to do today?"
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 ob In PrintDlg.OptionButtons
If ob.Value = xlOn Then
Sheets(ob.Caption).Activate
Exit For
End If
Next ob
End If
Else
MsgBox "All worksheets are empty."
End If

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

End Sub






Thanks for reading!

Kris Taylor

*** Sent via Devdex http://www.devdex.com ***
Don't just participate in USENET...get rewarded for it!