[Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2581
  • Last Modified:

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

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
shawks
Asked:
shawks
  • 4
  • 2
1 Solution
 
dlmilleCommented:
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
 
dlmilleCommented:
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
 
shawksAuthor Commented:
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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
shawksAuthor Commented:
Thanks again - for both the solution and the speed of response.

Steve
0
 
dlmilleCommented:
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
 
lpwesdCommented:
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
 
dlmilleCommented:
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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now