Solved

Excel 2010 - Using VBA Userform to dynamically select multiple sheets and publish it as a PDF

Posted on 2012-03-29
7
2,159 Views
Last Modified: 2012-06-04
I have a workbook with multiple worksheets and I would like a VBA script that will bring up a userform with all the visable sheets on with a check box next to each one. I would then like to be able to tick each sheet that I want to publish to a single PDF using Excel 2010's in built pdf option.

If posible I would like a tick box at the bottom that when selected populates all the other tick boxes allowing me to quickly select all worksheets ~ but still egiving me the opportunity to deselect individual worksheets.

Thank You
example-of-userform.bmp
0
Comment
Question by:shawks
  • 4
  • 2
7 Comments
 
LVL 41

Expert Comment

by:dlmille
ID: 37786040
You would get more responses if you'd post something that didn't require Experts to build your project from scratch.  I suggest you delete the data/or obfuscate it in your worksheets, then upload your workbook as is, with your userform and macros.

Most questions are solved in 15-30 minutes, though some, with interested experts might take hours - your best bet is to get questions in order such than an Expert with skill can solve it quickly.

For this particular problem, printing to PDF is trivial.

The below code has a sub called printSheetsToPDF()

Usage:  printSheets(strSheetsToPrint As String, pdfFile As String)
strSheetsToPrint - comma delimited sheet names  (e.g., "Sheet1,Sheet5,Sheet10")
pdfFile - full path of PDF file to be created (e.g., "mypath\myfile.PDF")

Option Explicit
Const strSheets = "Sheet1,Sheet2,Sheet4,Sheet6"    'userform makes call to printSheets with this string
Sub printSheetsToPDF(strSheetsToPrint As String, pdfFile As String)
Dim wkb As Workbook
Dim wks As Worksheet
Dim vSheets As Variant

    Set wkb = ThisWorkbook
    Set wks = ActiveSheet
    
    vSheets = Split(strSheetsToPrint, ",")

    wkb.Sheets(vSheets).Select
    
    On Error Resume Next 'this method must exist, and should in Excel 2007+.  Excel 2007 latest SP has this addin, otherwise, it can be downloaded at http://labnol.blogspot.com/2006/09/office-2007-save-as-pdf-download.html
    wkb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFile, quality:=xlQualityStandard, includedocproperties:=True, _
                            ignoreprintareas:=False, openafterpublish:=True
    On Error GoTo 0
    
    wks.Select
    
End Sub
Sub callToPrintPDF()
    Call printSheetsToPDF(strSheets, getFileNameOnly(ThisWorkbook.FullName) & ".PDF")
End Sub
Public Function getFileNameOnly(fname As String) As String
    getFileNameOnly = Left(fname, Len(fname) - Len(getFileExt(fname)))
End Function
Public Function getFileExt(fname As String) As String
Dim i As Integer

    i = InStr(StrReverse(fname), ".")
    getFileExt = StrReverse(Left(StrReverse(fname), i))

End Function

Open in new window


See attached simple demonstration

Cheers,

Dave
printToPDFSelectedSheets-r1.xlsm
0
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
ID: 37786333
Here's your solution.  I mocked up the first five checkboxes and the select all checkboxes, then created sheets corresponding to the checkboxes.

What's interesting about issues associated with the ExportToPDF method as it will print the entire workbook, independent of sheet selection.  

So, not so trivial after all!

My interest was peaked and so I wanted to develop this out a bit and had a brainstorm after some testing - ExportToPDF only prints VISIBLE sheets, so the act of hiding non-needed sheets then printing, then reverting back to the prior state created the solution.

Here's the userform code:
Option Explicit

Private Sub CheckBox6_Click()
Dim ctrl As Control
Dim myDict As Object
Dim wks As Worksheet

    Set myDict = CreateObject("Scripting.Dictionary")
    
    For Each wks In ThisWorkbook.Sheets
        myDict.Add wks.Name, Nothing
    Next wks
    
    For Each ctrl In Me.Controls
        If myDict.exists(ctrl.Caption) Then 'there's a corresponding worksheet with same name as checkbox caption
            ctrl.Value = CheckBox6.Value
        End If
    Next ctrl
    
    myDict.RemoveAll
    Set myDict = Nothing
End Sub
Private Sub CommandButton1_Click()
Dim ctrl As Control
Dim myDict As Object
Dim wks As Worksheet
Dim strsheets As String

    Set myDict = CreateObject("Scripting.Dictionary")
    
    For Each wks In ThisWorkbook.Sheets
        myDict.Add wks.Name, Nothing
    Next wks
    
    For Each ctrl In Me.Controls
        If myDict.exists(ctrl.Caption) Then 'there's a corresponding worksheet with same name as checkbox caption
            If ctrl.Value Then
                If strsheets = vbNullString Then
                    strsheets = ctrl.Caption
                Else
                    strsheets = strsheets & "," & ctrl.Caption
                End If
            End If
        End If
    Next ctrl
    
    Call printSheetsToPDF(strsheets, getFileNameOnly(ThisWorkbook.FullName) & ".PDF")
    Unload Me
    
    myDict.RemoveAll
    Set myDict = Nothing
End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub

Private Sub UserForm_Click()

End Sub

Open in new window


And code in a public module:
Option Explicit
Const strsheets = "Sheet1,Sheet2,Sheet4,Sheet6"    'userform makes call to printSheets with this string
Sub printSheetsToPDF(strSheetsToPrint As String, pdfFile As String)
Dim wkb As Workbook
Dim wks As Worksheet
Dim vSheets As Variant
Dim myDict As Object
Dim myDictVisible As Object
Dim i As Long

    Set wkb = ThisWorkbook
    Set wks = ActiveSheet
    Set myDict = CreateObject("Scripting.Dictionary")
    Set myDictVisible = CreateObject("Scripting.Dictionary")
    
    vSheets = Split(strSheetsToPrint, ",")
    
    'capturing visibility
    For Each wks In wkb.Sheets
        myDictVisible.Add (wks.Name), wks.Visible
    Next wks
    
    'make PDF sheets visible
    For i = LBound(vSheets) To UBound(vSheets)
        wkb.Sheets(vSheets(i)).Visible = xlSheetVisible
        myDict.Add vSheets(i), Nothing
    Next i
    
    'make all other sheets not visible
    For Each wks In wkb.Sheets
        If Not myDict.exists(wks.Name) Then
            wks.Visible = xlSheetHidden
        End If
    Next wks
        
    'select sheets to print (not really necessary, as all visible sheets will be printed with the ExportAsFixedFormat method
    'wkb.Sheets(vSheets).Select
    
    On Error Resume Next 'this method must exist, and should in Excel 2007+.  Excel 2007 latest SP has this addin, otherwise, it can be downloaded at http://labnol.blogspot.com/2006/09/office-2007-save-as-pdf-download.html
    
    If Dir(pdfFile) <> vbNullString Then
        Kill pdfFile
        If Err.Number <> 0 Then
            MsgBox "Cannot delete PDF File: " & pdfFile & " You may have it open - close it and try again"
            Exit Sub
        End If
    End If
    
    Err.Clear
    wkb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFile, quality:=xlQualityStandard, includedocproperties:=True, _
                            ignoreprintareas:=False, openafterpublish:=True
                            
    If Err.Number <> 0 Then
        MsgBox "Could not successfully create PDF file, perhaps you need to ensure you're running Excel 2007 with latest patches or Excel 2010"
    End If
    On Error GoTo 0
    
    'restore to prior visibility
    For Each wks In wkb.Sheets
        wks.Visible = myDictVisible(wks.Name)
    Next wks
    
    myDict.RemoveAll
    myDictVisible.RemoveAll
    Set myDict = Nothing
    Set myDictVisible = Nothing
End Sub
Sub loadForm()
    Load UserForm1
    UserForm1.Show
End Sub
Function sheetName(r As Range) As String
    sheetName = r.Worksheet.Name
End Function
Sub callToPrintPDF()
    Call printSheetsToPDF(strsheets, getFileNameOnly(ThisWorkbook.FullName) & ".PDF")
End Sub
Public Function getFileNameOnly(fname As String) As String
    getFileNameOnly = Left(fname, Len(fname) - Len(getFileExt(fname)))
End Function
Public Function getFileExt(fname As String) As String
Dim i As Integer

    i = InStr(StrReverse(fname), ".")
    getFileExt = StrReverse(Left(StrReverse(fname), i))

End Function

Open in new window


You may notice the use of Dictionary alot in this.  That's thanks to my learnings from matthewspatrick's great article: http://www.experts-exchange.com/searchResults.jsp?searchTerms=matthewspatrick+dictionary&componentHtmlId=basicSearch&searchType=10


see attached.

Dave
printToPDFSelectedSheets-r1.xlsm
0
 

Author Comment

by:shawks
ID: 37788370
Hi Dave

Thanks for taking the time to look into my problem.

I take on board your comments about the way I presented the problem and I will ensure I follow your advice in future.

Please accept my apologies if it looked like I was taking advantage.

Your solution works brilliantly and I tahnk you again for taking the time to answer.

Steve
0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 

Author Closing Comment

by:shawks
ID: 37788382
Thanks again - for both the solution and the speed of response.

Steve
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37788500
No need for apologies

My feedback was only to ensure yOu have the best chance of success and speedy responses from experts.

Cheers

Dave
0
 

Expert Comment

by:lpwesd
ID: 38042943
The idea of a checkbox for publishing to a PDF file is exactly what I am looking for, but I can not seem to get this one to work (most likely my lack of skill).

I have this one that uses the checkbox to print (it works).  Is it possible to modify it for PDF publishing?

Thanks

Option Explicit

Sub SelectSheets()
    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

'   Hides the intro requiring macros and development pages

    Worksheets("Intro - Do Not Print").Visible = False
    Worksheets("DEVELOPMENT - ERASE").Visible = False
   
'   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 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 WORKSHEETS 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).Select Replace:=False
                End If
            Next cb
            ActiveWindow.SelectedSheets.PrintOut
            ActiveSheet.Select
    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 Sheet1.Range("A1"), True
End Sub
0
 
LVL 41

Expert Comment

by:dlmille
ID: 38045687
I'm sure there is.  However, you can ask a new question with your needs, also referencing this thread as a link in that question for context.

Cheers,

Dave
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
Viewers will learn the basics of slicers and timelines for both PivotTables and standard Excel tables in Excel 2013.
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now