Solved

Excel: VBA to Save Worksheets as a Named File

Posted on 2014-04-27
15
545 Views
Last Modified: 2014-05-01
Hello,

I'm seeking some help on the below Excel VBA code. This is what I would like it to do:

1. User clicks a button, triggering a message box
2. If the user clicks 'Yes - Save' on the message box, Excel selects the four noted worksheets and saves them as a PDF, using the filename noted in cell 'savename'.
3. If the user selects 'No - Wait', nothing happens.

Below is my try at coding this. Can you help.


---

Sub mac_PDF4Pages()

mac_PDF4Pages Macro

MSG1 = MsgBox("Are you sure you want to save this PDF as "&(savename)&".PDF?,"Yes - Save","No - Wait")

If MSG1 = "Yes - Save" then

    Sheets(Array("PDFpg1", "Quote Page-Full", "PDFpg3", "PDFpg4")).Select
    Sheets("Quote Page-Full").Activate
    ThisFile = Range("savename").Value
    ActiveWorkbook.SaveAs Filename:=ThisFile

Else
Sheets("Quote Page-Full").Activate

Open in new window


End Sub
0
Comment
Question by:dabug80
  • 7
  • 7
15 Comments
 
LVL 27

Expert Comment

by:MacroShadow
ID: 40026588
I'm not sure why you want to select the sheets.

Sub mac_PDF4Pages()

    If MsgBox("Are you sure you want to save this PDF as " & (savename) & ".PDF?", vbYesNo) = vbYes Then
        ThisFile = Range("savename").Value
        ActiveWorkbook.SaveAs Filename:=ThisFile
    Else
        Sheets("Quote Page-Full").Activate
    End If

End Sub

Open in new window

0
 
LVL 1

Author Comment

by:dabug80
ID: 40026594
Hi MacroShadow.

The workbook contains other sheets too. I only want it to select and print the four sheets I listed ("PDFpg1", "Quote Page-Full", "PDFpg3", "PDFpg4")
0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 40026615
Hi,

pls try

Sub mac_PDF4Pages()

mac_PDF4Pages Macro

MSG1 = MsgBox("Are you sure you want to save this PDF as "&(savename)&".PDF?,"Yes - Save","No - Wait")

If MSG1 = "Yes - Save" then

    Sheets(Array("PDFpg1", "Quote Page-Full", "PDFpg3", "PDFpg4")).Copy ' Create a new workbook with this sheets
    Sheets("Quote Page-Full").Activate
    ThisFile = Range("savename").Value
    ActiveWorkbook.SaveAs Filename:=ThisFile
    ActiveWorkbook.Close savechanges:=False

Else
Sheets("Quote Page-Full").Activate

Open in new window

Regards
0
 
LVL 27

Expert Comment

by:MacroShadow
ID: 40026622
Sub mac_PDF4Pages()

    Dim ThisFile As String
    
    ThisFile = Sheets("Quote Page-Full").Range("savename").Value

    If MsgBox("Are you sure you want to save this PDF as " & (ThisFile) & ".PDF?", vbYesNo) = vbYes Then
        Sheets(Array("PDFpg1", "Quote Page-Full", "PDFpg3", "PDFpg4")).Copy ' Create a new workbook with this sheets
        ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisFile, Quality:=xlQualityStandard, _
                                        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        ActiveWorkbook.Close SaveChanges:=False
    Else
        Sheets("Quote Page-Full").Activate
    End If

End Sub

Open in new window


Note: Range("savename") must be a full file name including path (without the extension), i.e. C:\Test\test
0
 
LVL 1

Author Comment

by:dabug80
ID: 40033799
Thanks MacroShadow. Works well. Sorry for the silly question but can you incorporate the C:\Test\test range into the code so I can see exactly how it's expressed.

Cheers
0
 
LVL 27

Expert Comment

by:MacroShadow
ID: 40033857
Sub mac_PDF4Pages()

    Dim ThisFile As String
    
    'ThisFile = Sheets("Quote Page-Full").Range("savename").Value
    ThisFile = "C:\Test\test"

    If MsgBox("Are you sure you want to save this PDF as " & (ThisFile) & ".PDF?", vbYesNo) = vbYes Then
        Sheets(Array("PDFpg1", "Quote Page-Full", "PDFpg3", "PDFpg4")).Copy ' Create a new workbook with this sheets
        ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisFile, Quality:=xlQualityStandard, _
                                        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        ActiveWorkbook.Close SaveChanges:=False
    Else
        Sheets("Quote Page-Full").Activate
    End If

End Sub

Open in new window

0
 
LVL 1

Author Comment

by:dabug80
ID: 40033871
Further to the above comment,

I have named a cell 'savepath'. This gives the file path reference (e.g c:\test). How would I therefore incorporate this cell reference as the file path in the MacroShadow code?

Cheers again
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 27

Expert Comment

by:MacroShadow
ID: 40033895
Sub mac_PDF4Pages()

    Dim ThisFile As String
    
    ThisFile = Sheets("Quote Page-Full").Range("savepath").Value

    If MsgBox("Are you sure you want to save this PDF as " & (ThisFile) & ".PDF?", vbYesNo) = vbYes Then
        Sheets(Array("PDFpg1", "Quote Page-Full", "PDFpg3", "PDFpg4")).Copy ' Create a new workbook with this sheets
        ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisFile, Quality:=xlQualityStandard, _
                                        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        ActiveWorkbook.Close SaveChanges:=False
    Else
        Sheets("Quote Page-Full").Activate
    End If

End Sub

Open in new window

0
 
LVL 1

Author Comment

by:dabug80
ID: 40033927
Thanks.

This gives me a runtime error 1004. I click debug and line 9 & 10 of your code are highlighted in yellow.
0
 
LVL 27

Expert Comment

by:MacroShadow
ID: 40033981
What is the value of ThisFile at the time of error?

To get the value, in the immediate window (ctrl+G to open it) type ?ThisFile then press Enter.
0
 
LVL 1

Author Comment

by:dabug80
ID: 40036028
The code seems to create a new workbook and duplicate the sheets for PDF publishing. I tried to press (ctrl+G) on this duplicate workbook but it did not trigger anything. I could not select the original workbook to press ctrl+ G.

I therefore clicked 'debug' again, but I got the message 'out of memory'. It's worth nothing that three of the Worksheets have large images on them. The total file size of the xlsx file is 3.5MB.

I also don't have a 'ThisFile' naming reference setup. I figure that's a particular hard code reference?

Cheers.
0
 
LVL 27

Expert Comment

by:MacroShadow
ID: 40036381
I could not select the original workbook to press ctrl+ G.
Why not?

I also don't have a 'ThisFile' naming reference setup. I figure that's a particular hard code reference?
ThisFile is a variable that holds the value of your savepath cell. It is populated in this line:
ThisFile = Sheets("Quote Page-Full").Range("savepath").Value

Open in new window


What path do you have in the savepath cell?

It is possible you're encountering an error if you are using the root of the drive (i.e c:\) to save the file in.
0
 
LVL 1

Author Comment

by:dabug80
ID: 40036435
I could not select the original workbook to press ctrl+ G.

Why not?

I'm met with the attached runtime error. Plus my cursor is stuck in 'thinking hour glass' mode. This is all happening within the mirror workbook 'book 1'. I can't return to the core workbook without hitting end or debug on the attached error message.

What path do you have in the savepath cell?

It is possible you're encountering an error if you are using the root of the drive (i.e c:\) to save the file in.

Originally I had C:\. I've since changed this to S:\ (another viable location).

No PDFs were saved in the above process due to the error message

:(
VBerror.gif
0
 
LVL 27

Accepted Solution

by:
MacroShadow earned 500 total points
ID: 40036462
I can't return to the core workbook without hitting end or debug on the attached error message.
Correct. Hit Debug then type ?ThisFile in the immediate window and press Enter. What is the value?

Originally I had C:\. I've since changed this to S:\ (another viable location).
Don't use a root, try a deeper path such as S:\Test\test. As I wrote, Windows at times won't let you save to the root do to permission issues.
0
 
LVL 1

Author Closing Comment

by:dabug80
ID: 40036468
Thanks for your excellent solution. Very much appreciated.

Once I set the path to a folder deeper on S:\ it worked perfectly.

You are a champion.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

914 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