I have some code to save a specific excel worksheet in a specific location. I'd like to change the code in order to save in the same directory that the file was originally opened in. Currently it's set to save in my C:\ but if I had opened the file from a different directly, I would like it saved there.
Sheets("Lease Charts").Activate
With Sheets("Lease Charts")
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\Temp " & Format(Range("L1"), "mm-dd-yyyy"), _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
Just you ThisWorkbook.Path Like so:
With Sheets("Lease Charts")
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\Temp " & Format(Range("L1"), "mm-dd-yyyy"), _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
Figured it out by just removing the specific directory from the filename !
Sheets("Lease Charts").Activate
With Sheets("Lease Charts")
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="Temp " & Format(Range("L1"), "mm-dd-yyyy"), _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
Related
I have a file has 4 columns (A B C D) with the "Manager" in column A and the Employee numbers in Column B with example info per employee in C & D. What I would like to do is to be able to have a print macro that would print all the employees under each manager on a PDF with the headers repeating at the top. So when the print macro is clicked on, it would ask, "Which Manager"? Then it would be clicked and then it would print the PDF.
Is this possible? I've been researching loops and I was thinking that would be the way to do it but cannot seem to figure out how to replace my "Range" below. It is example code that I use in another file with static ranges.
Any help is much appreciated! Thank you. P.S. sorry about the code formatting, I cannot seem to get used to Stack Overflow's way of editing it.
Sub Dept_BGT_Print()
Range("C14:R45").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"John Dept BGT.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
Range("C47:R59").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"HR Dept BGT.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
Range("C62:R126").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"Marketing & Sales Dept BGT.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
Range("C128:R207").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"Skip Dept BGT.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
Range("C209:R250").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"Amy Dept BGT.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub
If you're interested in printing one manager at a time, your best option is probably to just go with an AutoFilter.
Sub Dept_BGT_Print()
Dim Sel_Manager As String
'Specify headers to be repeated at the top
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
'Manager selection through simple Inputbox
Sel_Manager = InputBox("Which manager?")
'Insert autofilter for worksheet
Cells.Select
Selection.AutoFilter
'Select manager defined in inputbox
ActiveSheet.Range("A1", Range("D1").End(xlDown)).AutoFilter Field:=1, Criteria1:=Sel_Manager
'Select range to be printed and specify manager in filename
ActiveSheet.Range("A1", Range("D1").End(xlDown)).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"Employees for manager " & manager & ".pdf", Quality:=xlQualityStandard,
_IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
'remove autofilter
ActiveSheet.ShowAllData
End Sub
im trying to save multiple worksheets as single pdf file.
Following macro is using Sheets names, but it does not fit me well as my sheets have dynamic names. Was trying to use Sheets(1) addressing but did not work. Does anyone have any idea?
Sub export_to_pdf()
Sheets(Array("Configuration", "chart")).Copy
ActiveWorkbook.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="filename.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
ActiveWorkbook.Close (False)
End Sub
use
Sheets(1).ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="filename.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
or if you have more
Sheets(Array(1, 2, 5)).Copy
ActiveWorkbook.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="filename.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
ActiveWorkbook.Close (False)
Your program code works for me with minor changes indicate here-under.
Sub export_to_pdf()
Sheets(Array("Sheet1", "Sheet2")).Copy 'Change to your sheets
ActiveWorkbook.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="filename.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _ 'changed to True
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
ActiveWorkbook.Close (False)
End Sub
In such cases I set reference to Microsoft Word Object Library also in Tools Reference
I'm Trying to create a directory in excel-VBA and then copy the xlsm and ,pdf file into this directory.
I can create the directory but I can't seem to save the files into this directory?
Code below. Any Help is much appreciated. This is driving me crazy. All I'm doing is concatenating the filename and it's being saved to the c:\temp folder, but I want it to save it into a sub folder in c:\temp
Sub Macro2()
'
' Macro2 Macro
'
Dim FileName As String
Dim FileName2 As String
'FileName3 As String
FileName = Sheet1.TextBox1.Text
FileName2 = ("C:\TEMP\" & FileName)
'CheckDir As String
MsgBox (FileName2)
MkDir (FileName2)
ChDir (FileName2)
ActiveWorkbook.SaveAs FileName:=FileName2 & FileName & "2xlsm.xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
FileName2 & "FileName" & "_2xlsm.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub
enter image description here
The format of FileName2 should be fixed to properly concatenate FileName in the file creation. Also, the FileName argument of both SaveAs and ExportAsFixedFormat should be the same, assuming you want both the XLSM and PDF files to be saved in one directory.
Please refer to the modified code below:
Sub Macro2()
'
' Macro2 Macro
'
Dim FileName As String
Dim FileName2 As String
FileName = Sheet1.TextBox1.Text
FileName2 = "C:\TEMP\" & FileName & "\"
MsgBox (FileName2)
MkDir (FileName2)
ChDir (FileName2)
ActiveWorkbook.SaveAs FileName:=FileName2 & FileName & "2xlsm.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
FileName2 & FileName & "_2xlsm.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub
Your missing & "\" & (backslash) on FileName2 & "\" & FileName, _
See Complete code
Option Explicit
Sub Macro2()
'
' Macro2 Macro
'
Dim FileName As String
Dim FileName2 As String
FileName = Sheet1.TextBox1.Text
FileName2 = ("C:\TEMP\" & FileName)
MsgBox (FileName2)
MkDir (FileName2)
ActiveWorkbook.SaveAs FileName:= _
FileName2 & "\" & FileName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
CreateBackup:=False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
FileName2 & "\" & "FileName", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
Or simply do this
FileName2 = ("C:\TEMP\" & FileName & "\")
I am trying to print an active sheet as a PDF, is it also possible to print page 1 and 2 separately? i have this so far. i want the name of the export to use the values from cells B1 I1 and J1
Sub PDFActiveSheet()
Dim ws As Worksheet
Dim strPath As String
Dim myFile As Variant
Dim strFile As String
On Error GoTo errHandler
Set ws = ActiveSheet
'enter name and select folder for file
' start in current workbook folder
strFile = Replace(Replace(ws.Name, " ", ""), ".", "_") _
& "_" _
& Range("B1"&"I1"&"J1") _
& ".pdf"
strFile = ThisWorkbook.Path & "\" & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created."
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
Just use the From and To parameters of the ExportAsFixedFormat function:
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False, _
From:=1, _
To:=1
and the same again with page 2
I have some problem with my mailmerge macro in this part:
wdocSource.Mailmerge.OpenDataSource _
Name:=strWorkbookName, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
SQLStatement:="SELECT * FROM `Mailing$`"
Can somebody help me change the connection settings? I am try many ways but always dont run correctly.