Print Macro :: MrExcel Message Board


 FAQFAQ
   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   FavoritesFavorites   StatisticsStatistics 
 RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 
Online StoreOnline Store

MrExcel Message Board Forum Index -> Excel Questions

Print Macro
Post new topic   Reply to topic
Last Thread | Next Thread  >   Printable version
  Author    Thread

isis
Board Regular


Joined: 26 May 2003
Posts: 77

Flag: Uk

Status: Offline

 Reply with quote  

Print Macro

Hi There,

I have a print macro that users run to select which sheets of a workbook they want to print. ( The code came from this forum a while back and I tailored it to suit my needs). The macro works fine, the only slight (but annoying) problem being that after the macro has run, it kicks the user out of the worksheet they were in and into a different sheet (Sheet 7). If the macro is run from sheet 7 then the user remains in this sheet but any other sheet bumps the user into sheet 7 and I can't for the life of me figure out why - or how to correct it. Surely CurrentSheet.Activate should take the user back to their current screen? But it doesn't. Can anyone suggest a remedy?

I've copied the code below in case it helps.

Thanks.

------------------


Sub PRINT_SHEETS()
Dim sh As Worksheet

Application.ScreenUpdating = True

Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
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.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Skip empty sheets and hidden sheets

If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible = xlSheetVisible 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
Worksheets(cb.Caption).Activate
ActiveSheet.PrintOut
' 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
CurrentSheet.Activate

Application.ScreenUpdating = True


-------------------

Post Sat Sep 20, 2003 10:19 am 
 View user's profile Send private message

Richie(UK)
MrExcel MVP


Joined: 18 May 2002
Posts: 2464
Location: Worcester, England
Flag: Uk

Status: Offline

 Reply with quote  

Re: Print Macro

Hi,

Although the CurrentSheet variable is set to the ActiveSheet at the start of the code it is subsequently changed during the For ... Next loop that counts the worksheets. I would recommend using a For Each ... Next loop instead using the sh worksheet variable (which although declared does not appear to be used in the routine icon_confused.gif ) or using another variable for the activesheet at the time the routine is invoked,eg.

code:
Sub SelectSheets()
    Dim i As Integer
    Dim TopPos As Integer
    Dim SheetCount As Integer
    Dim PrintDlg As DialogSheet
    Dim CurrentSheet As Worksheet
    Dim wsAS As Worksheet
    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 wsAS = ActiveSheet
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add

    SheetCount = 0

'   Add the checkboxes
    TopPos = 40
    For i = 1 To ActiveWorkbook.Worksheets.Count
        Set CurrentSheet = ActiveWorkbook.Worksheets(i)
'       Skip empty sheets and hidden sheets
        If Application.CountA(CurrentSheet.Cells) <> 0 And _
            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
                    Worksheets(cb.Caption).Activate
                    ActiveSheet.PrintOut
'                   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
    wsAS.Activate
End Sub



Also, you may have seen the code here on the forum but it looks suspiciously like the JWalk routine to me icon_wink.gif

http://www.j-walk.com/ss/excel/tips/tip48.htm
_________________
Richie

Post Sat Sep 20, 2003 2:25 pm 
 View user's profile Send private message

George J
Board Master


Joined: 16 Feb 2002
Posts: 375
Location: Edinburgh, Bonnie Scotland
Flag: Scotland

Status: Offline

 Reply with quote  

Re: Print Macro

Just make these small changes.

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

and

' Reactivate original sheet
Sheets(x).Select

Just the 2 lines needed a tweak.
_________________
George J

Post Sat Sep 20, 2003 4:20 pm 
 View user's profile Send private message Send e-mail

isis
Board Regular


Joined: 26 May 2003
Posts: 77

Flag: Uk

Status: Offline

 Reply with quote  

Re: Print Macro

Thanks Guys

That macro works great now.

Isis

Post Sat Sep 20, 2003 5:20 pm 
 View user's profile Send private message

Iridium
Board Master
Board Master


Joined: 16 Jul 2002
Posts: 2581
Location: Walsall, England
Flag: England

Status: Offline

 Reply with quote  

Re: Print Macro

Just for info here's the original

http://j-walk.com/ss/excel/tips/tip48.htm
_________________

Post Sun Sep 21, 2003 9:14 am 
 View user's profile Send private message

Richie(UK)
MrExcel MVP


Joined: 18 May 2002
Posts: 2464
Location: Worcester, England
Flag: Uk

Status: Offline

 Reply with quote  

Re: Print Macro

quote:
Originally posted by Iridium:
Just for info here's the original

http://j-walk.com/ss/excel/tips/tip48.htm
icon_confused.gif Is this somehow different to the link I provided above?
quote:
Originally posted by Richie(UK):
Also, you may have seen the code here on the forum but it looks suspiciously like the JWalk routine to me icon_wink.gif

http://www.j-walk.com/ss/excel/tips/tip48.htm

_________________
Richie

Post Sun Sep 21, 2003 9:52 am 
 View user's profile Send private message

Iridium
Board Master
Board Master


Joined: 16 Jul 2002
Posts: 2581
Location: Walsall, England
Flag: England

Status: Offline

 Reply with quote  

Re: Print Macro

Richie

Nope its not - obviously not enough coffee for me this Sunday morning! icon_redface.gif
_________________

Post Sun Sep 21, 2003 10:03 am 
 View user's profile Send private message

Richie(UK)
MrExcel MVP


Joined: 18 May 2002
Posts: 2464
Location: Worcester, England
Flag: Uk

Status: Offline

 Reply with quote  

Re: Print Macro

icon_mrgreen.gif

(PS: Can you ever have 'enough' coffee? icon_wink.gif )
_________________
Richie

Post Sun Sep 21, 2003 10:22 am 
 View user's profile Send private message

Iridium
Board Master
Board Master


Joined: 16 Jul 2002
Posts: 2581
Location: Walsall, England
Flag: England

Status: Offline

 Reply with quote  

Re: Print Macro

Agreed Richie. btw your Avatar is a caffeine molecule isn't it?
_________________

Post Sun Sep 21, 2003 10:24 am 
 View user's profile Send private message
  Display posts from previous:      

MrExcel Message Board Forum Index -> Excel Questions


Forum Jump:
Jump to:  

Post new topic   Reply to topic
Page 1 of 1



Add To Favorites

 


Forum Rules:
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum

Powered by phpBB: 2.0.4 © 2001 phpBB Group

Need help posting your first question? Read how to post

Need extra help ? Couldn't get the answer you needed ? Get a free quote from our Consulting Team

Download Colo's HTML Maker utility for displaying your Excel Worksheet on the board.

Download VB HTML Maker to post your code on the board


Check out our new index to 485 Excel Articles.


Return to MrExcel Consulting

All contents Copyright 1998-2004 by MrExcel.com
If you believe information posted here is from your copyrighted source, notify us per the Terms of Use
Excel is a registered trademark of the Microsoft Corporation.
MrExcel is a registered trademark of Tickling Keys, Inc.