Save an Excel file and export it to pdf with a different sheet - vba

I have never written VBA code, but I checked on internet for some information.
My wish is the following: I have an Excel file with 3 sheets. On one of them, I'd like to add one button which can:
Save the totality of my Excel file following this naming convention: [name of a cells of a page]_AP_[date of today].xls.
Save one of the sheets in a .pdf file.
Print 2 of the 3 sheets while adjusting the contents.
I already started something, but I'm really bad at programming:
Public Sub Savefile_Click() 'copie sauvegarde classeur
' save my file following a name
Dim nom As String
Dim chemin As String
Dim wSheet As Worksheet
chemin = "C:\Users\aaa\Desktop"
nom = [Q13].Value & "_" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) _
& ".xlsm"
With ActiveWorkbook
.SaveAs Filename:=chemin & nom
.Close
rep = MsgBox("Fichier excell sauvegardé")
End With
' ... and print my active sheet (where the button will stay)
For Each wSheet In ActiveWorkbook.Worksheets
If wSheet.Visible Then wSheet.PrintOut
Next
'Save my page 'offre' in pdf on my desktop and print it
Worksheets("OFFRE A ENVOYER").Range("A1:i47").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=[Q13].Value & "_Offre de prix", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
After that there will be another option and details, but this is really the base.

1) Save as Excel
Dim nom As String
nom = ThisWorkbook.Sheets(1).Range("Q13").Value & "AP" & Format(Date, "ddmmyyyy") & ".xls"
thisworkbook.saveas sPath & nom 'Define path first, don't forget the \ at the end.
Even better would be to create a named range from range "Q13" and use:
nom = thisworkbook.names("Something").referstorange.value
To make the link dynamic in case you insert a column or row which shifts all your ranges.
2) Save workbook as PDF
ThisWorkbook.ExportAsFixedFormat xlTypePDF, sPath & sFile 'Define here .pdf
3)
"print 2 of the 3sheets with adjusting the contenant of a "
I'm not sure if I get this one...
Print command is given by:
Set oSheet= thisworkbook.sheets(2)
with oSheet.PageSetup
.PrintArea = "$A1$1:$Q$40"
...
'Any other properties: http://www.java2s.com/Code/VBA-Excel-Access-Word/Excel/AllpropertiesofPageSetup.htm
end with
oSheet.printout
Which ever way you want to program this in order to retrieve the sheets that you need to print.
You can loop through the sheets with a counter and put if statements to add conditions.
dim oSheet as Excel.worksheet
dim iCnt as integer
For each oSheet in thisworkbook.sheets
iCnt = iCnt + 1
'Include conditions here
If ... then 'Whatever condition
set oSheet = thisworkbook.sheets(iCnt)
'Print
end if
next oSheet

thank you ...i was searching this. this worked very well.
Option Explicit
Sub SvMe() 'Save filename as value of A1 plus the current date
Dim newFile As String, fName As String
' Don't use "/" in date, invalid syntax
fName = Range("A1").Value
newFile = fName & " " & Format$(Date, "mm-dd-yyyy")
' Change directory to suit
ChDir _
"C:\Users\user\Desktop" 'YOU MUST Change USER NAME to suit
ThisWorkbook.ExportAsFixedFormat xlTypePDF, Filename:=newFile
End Sub
this
1. saves my file in pdf format and
2. does not prompt me for attending save as dialog box
3. saves file using cell value in A1 and date stamp

Related

How to get the sheet name using GetOpenFilename in VLOOKUP

I am using this code down below to use a VLOOKUP in another file that you select using the GetOpenFilename. I want shtName to be the name of the sheet in the file that you select, but whenever I step through it, it is always the name of the sheet that I am working in and putting the VLOOKUP in.
I have shtName in my VLOOKUP and it doesn't show anything when I step through it. X shows the filename and path, but shtName right after shows nothing. But my VLOOKUP ends up working anyway and it puts the sheet in the formula.
Why is that? I want to be able to do it myself and so I know I get the sheet name from the file you are selecting.
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String
' Promt
strPrompt = "Please select the last Kronos Full File before the dates of this HCM Report." & vbCrLf & _
"This will be used to find the Old Position, Org Unit, and Old Cost Center." & vbCrLf & _
"For example, if the date of this report is 7-28-17 thru 8-25-17, the closest Kronos Full File you would want to use is 7-27-17."
' Dialog's Title
strTitle = "Last Kronos Full File for Old Positions"
'Display MessageBox
iRet = MsgBox(strPrompt, vbOK, strTitle)
Dim LR As Long
Dim X As String
Dim lNewBracketLocation As Long
X = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls*),*.xls*", _
Title:="Choose the Kronos Full File.", MultiSelect:=False)
MsgBox "You selected " & X
'Find the last instance in the string of the path separator "\"
lNewBracketLocation = InStrRev(X, Application.PathSeparator)
'Edit the string to suit the VLOOKUP formula - insert "["
X = Left$(X, lNewBracketLocation) & "[" & Right$(X, Len(X) - lNewBracketLocation)
shtName = ActiveWorkbook.Worksheets(1).name
LR = Range("E" & Rows.Count).End(xlUp).Row
Range("T2").Formula = "=VLOOKUP($E2,'" & X & "]shtName'!$B$1:$AP$99999,15,0)"
Stop
Range("T2").AutoFill Destination:=Range("T2:T" & Range("E" & Rows.Count).End(xlUp).Row)
Stop
Range("T2:T" & Range("E" & Rows.Count).End(xlUp).Row).Select
Stop
Range("U2").Formula = "=VLOOKUP($E2,'" & X & "]shtName'!$B$1:$AP$99999,41,0)"
Range("U2").AutoFill Destination:=Range("U2:U" & Range("E" & Rows.Count).End(xlUp).Row)
Range("U2:U" & Range("E" & Rows.Count).End(xlUp).Row).Select
Range("V2").Formula = "=VLOOKUP($E2,'" & X & "]shtName'!$B$1:$AP$99999,18,0)"
Range("V2").AutoFill Destination:=Range("V2:V" & Range("E" & Rows.Count).End(xlUp).Row)
Range("V2:V" & Range("E" & Rows.Count).End(xlUp).Row).Select
Cells.Select
Cells.EntireColumn.AutoFit
Something like the following should give you the worksheets name out of a file
Dim wbk As Workbook
Set wbk = Workbooks.Open(Filename:="YOUR_FILE_PATH", ReadOnly:=True)
Dim shtName As String
shtName = wbk.Worksheets(1).Name
wbk.Close
Note: We can open the workbook in read only mode if we don't plan to change anything.
Additionally I recommend (for a good code following good practices):
Always specify a worksheet.
Eg for every Range("") like Worksheets("YourSheetName").Range("")
Or use With statements:
With Worksheets("YourSheetName")
.Range("A1").Value = 5 'recognize the starting full stop referring to the with statement
End With
Same for every Rows, Columns, Cells, etc.
Avoid using .Select, .Activate and Selection. at all.
(there are many tutorials out there in the Internet how to avoid them).
Use Option Explicit and declare all your variables before use.
(avoids many issues, especially typos).

Saving a particular sheet from one workbook to another in a particular folder

I am trying to save a particular worksheet from my working workbook to another workbook, and trying to save it in the path of my current workbook. The saving option is in such a way that it should get saved with the dd.mm.yyyy.
I tried the following code and I am getting application defined error in the line
> newWB.SaveAs filename:=Path2 & Format(Now(), "yyyymmdd") &
> myWorksheets(i), FileFormat:=xlsx
Could you please help me figure out where I am wrong?
Sub save()
Dim myWorksheets() As String 'Array to hold worksheet names to copy
Dim newWB As Workbook
Dim CurrWB As Workbook
Dim i As Integer
Dim path1, Path2
path1 = ThisWorkbook.Path
Path2 = path1 & "\TT"
Set CurrWB = ThisWorkbook
myWorksheets = Split("Report", ",")
For i = LBound(myWorksheets) To UBound(myWorksheets) 'Go through entire array
Set newWB = Workbooks.Add 'Create new workbook
CurrWB.Sheets(Trim(myWorksheets(i))).Copy
newWB.SaveAs filename:=Path2 & Format(Now(), "yyyymmdd") & myWorksheets(i), FileFormat:=xlsx
newWB.Close saveChanges:=False
Next i
CurrWB.Save 'save original workbook.
End Sub
#Jenny - This code will accomplish what you ask in your question, it will save the ActiveSheet as a new file; and can be used as a function the can be called within your code. You can change the "Rpt" to identify the title of the new workbook. When I'm writing vba code, I always try to follow what my mother use to say to me, "Keep it simple".
Application.DisplayAlerts = False
Dim wbPath As String
wbPath = ThisWorkbook.Path
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=wbPath & "\" & "Rpt" & " " & Format(Date, "yyyymmdd") & ".xlsx", _
FileFormat:=51, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True

Correct Excel Macro to Save A Copy Excel File as TXT or CSV

So I have this home-made Excel Macro Template.
The task of the macro code that I inserted in my xlsm file is to Save a copy in the same folder with a different format. That format is .txt (see image below)
The expected result of the macro (after saving) should be the same with the excel file (visually) but this time it is in a .txt format.
Unfortunately, that didn't happened. It generates a different txt file and it contains unreadable alpha numeric characters, here's an example of the generated txt file.
¬TËNÃ0 ¼#ñ ‘¯(vဠjÚ # °µ· ©c[^SÚ¿g“–
P ö '±wfvìq 8o\1ÃD6øJœËž(Ðë`¬ŸTâõå¾¼ eð \ðX‰ ’ NOú/‹ˆTpµ§JÔ9Çk¥H×Ø É ÑóÌ8¤ 2 ¦‰Š §0AuÑë]* |FŸËÜbˆAÿ Çðîrq7çßK%#ëEq³\×RU btVCf¡jæ l¨ã±Õ(g#xJá
u j#XBG{Ð~J.Wr%WvŒTÛHgÜÓ †vf»ÜUÝ#ûœ¬Áâ R~€†›Rs§>BšŽB˜ÊÝ «žq®ÑIª ³l#§pçaä ý ë¿ î`ê*IuÃù ( ³´Ü ýÞð JŠ Át` “m'Ýû ™ ªîy¸„ f !å…C:r·KÐ}Ì5$4Ï9q Ž.à;ö. ¼] H ¼„ÿwá+mu S¶¸ŽÃ¦Ã¶fäÔ l;¶×‚A³ [u×Ðà ÿÿ PK ! µU0#ô L _rels/.rels ¢ (
Here's my macro code:
Sub SaveMe()
Dim FName As Range
Dim firstDate As String
Dim firstTime As String
Dim answer As Integer
firstDate = Format(Date, "mmddyyyy")
firstTime = Format(Now, "hhmmssAM/PM")
Set FName = Range("H5")
ActiveWorkbook.SaveCopyAs FileName:=ActiveWorkbook.Path & "\" & "QB JE " & FName & " " & firstDate & " " & firstTime & ".txt", FileFormat:=xlText, CreateBackup:=False
End Sub
I was wondering if anyone could take a look at my code and help to point out whats wrong.
It looks like you want the SaveAs Not the SaveCopyAs.
Fileformat xlText or xlTextMSDOS
You can two step the process. Save a copy, then open it, and save it as a text file.
ActiveWorkbook.SaveCopyAs FileName:=ActiveWorkbook.Path & "\" & "QB JE " & FName & " " & firstDate & " " & firstTime & ".xlsx"
Workbooks.Open (ActiveWorkbook.Path & "\" & "QB JE " & FName & " " & firstDate & " " & firstTime & ".xlsx")
ActiveWorkbook.SaveAs FileName:=ActiveWorkbook.Path & "\" & "QB JE " & FName & " " & firstDate & " " & firstTime & ".txt", FileFormat:=xlText, CreateBackup:=False
https://msdn.microsoft.com/en-us/library/office/ff841185.aspx
https://msdn.microsoft.com/en-us/library/office/ff198017.aspx
See from my post here. Excel VBA Export To Text File with Fixed Column Width + Specified Row and Columns Only + Transpose
Loop all rows and all cells. Send each value to a padspace function. Build the string from for each cells value with spaces padded after the cell value.
You will have to add a reference to you workbook. In the VBA IDE go to the tools pull down menu and select references. Then scroll down and select "Microsoft Scripting Runtime". Then hit OK.
Adjust the pad space function call argument to a number that fits the data that you have in your spreadsheet. So you will change the 20 in the line with the padspace call. PadSpace(20, len(cellValue))
This will do all rows and columns.
Public Sub MyMacro()
Dim lRow As Long
Dim lCol As Long
Dim strRow As String
Dim ws As Excel.Worksheet
Dim ts As TextStream
Dim fs As FileSystemObject
'Create the text file to write to
Set fs = New FileSystemObject
Set ts = fs.CreateTextFile("C:\Temp\test.txt", True, False)
Set ws = Application.ActiveSheet
'Loop through all the rows.
lRow = 1
Do While lRow <= ws.UsedRange.Rows.count
'Clear the string we are building
strRow = ""
'Loop through all the columns for the current row.
lCol = 1
Do While lCol <= ws.UsedRange.Columns.count
'Build a string to write out.
strRow = strRow & ws.Cells(lRow, lCol) & PadSpace(20, Len(ws.Cells(lRow, lCol)))
lCol = lCol + 1
Loop
'Write the line to the text file
ts.WriteLine strRow
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop
ts.Close: Set ts = Nothing
Set fs = Nothing
End Sub
'This function will take the max number of spaces you want and the length of the string in the cell and return you the string of spaces to pad.
Public Function PadSpace(nMaxSpace As Integer, nNumSpace As Integer) As String
If nMaxSpace < nNumSpace Then
PadSpace = ""
Else
PadSpace = Space(nMaxSpace - nNumSpace)
End If
End Function

Selecting Where PDF Files Save

I'm so relieved that I finally got the code below to work with the help of this community.
I have one more option on my wishlist that I'm struggling with. Currently, the code below will save worksheet 3 all the way to worksheet titled "post" as separate PDF files into a folder I select. This is triggered by a shape.
I'm trying to make the below code prompt a folder select so users can select where their PDF files are saved, does anyone have any ideas how to do this?
Also, the Call Shell at the bottom would preferably open the folder where the files are saved, but that's not really necessary as long as users know where the files are being saved :)
Sub SaveAllPDF()
Dim i As Integer
Dim Fname As String
Dim TabCount As Long
TabCount = Sheets("Post").Index
'Set the TabCount to the last cell you want to PDF
' Begin the loop.
For i = 3 To TabCount
'Set i = the number of the first sheet you want to PDF in order from left to right To TabCount
If Sheets(i).Visible <> xlSheetVisible Then
Else
With Sheets(i)
Fname = .Range("C15") & " " & .Range("E13") & "-" & .Range("B1")
'The Fname above is equaling the cells that the PDF's filename will be
'The folder directory below is where the PDF files will be saved
.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\Brandon\Desktop\operation automated\RLtemp\" & Fname, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
End If
Next i
Call Shell("explorer.exe" & " " & "C:\Users\Brandon\Desktop\operation automated\RLtemp\", vbNormalFocus)
'This opens the folder where the PDFs are saved
End Sub
You can just use the Excel's FileDialog object:
Sub SaveAllPDF()
Dim i As Integer
Dim Fname As String
Dim TabCount As Long
TabCount = Sheets("Post").index
'Set the TabCount to the last cell you want to PDF
Dim dialog As FileDialog
Dim path As String
Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
dialog.AllowMultiSelect = False
If dialog.Show = -1 Then
path = dialog.SelectedItems(1)
' Begin the loop.
For i = 3 To TabCount
'Set i = the number of the first sheet you want to PDF in order from left to right To TabCount
If Sheets(i).Visible <> xlSheetVisible Then
Else
With Sheets(i)
Fname = .Range("C15") & " " & .Range("E13") & "-" & .Range("B1")
'The Fname above is equaling the cells that the PDF's filename will be
'The folder directory below is where the PDF files will be saved
.ExportAsFixedFormat Type:=xlTypePDF, filename:=path & "\" & Fname, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
End If
Next i
Call Shell("explorer.exe" & " " & path & "\", vbNormalFocus)
'This opens the folder where the PDFs are saved
End If
End Sub

Export As A Fixed Format Excel 2007

I have been assigned the task of developing a excel document that whole office will use. The user will click a button and the macro will export the file as a PDF to a shared folder. I wrote this code and tested this code using excel 2010. People that have excel 2007 where getting an error message saying "Run Time Error 1004 Document not saved. This document may be open, or an error may have been encountered when saving." I looked into the problem a little bit and found that excel 2007 needed an add-in update, so I installed it on their computers. I also checked to see if they have adobe on their computers and they do. They are still having the problem and I am unsure of what to do. Any help would be greatly appreciated!
Here is my code
' Define all variables
Dim strFileName As String
Dim folder As String
Dim member As Integer
Dim member_count As Integer
Dim member_name As String
Dim show As Variant
Dim MyTime As String
'Save as new file
Worksheets("Input data").Visible = True
folder = Sheets("Input data").Range("location").Value
MyTime = Time
Sheets("Input data").Select
Range("G2").Value = MyTime
strFileName = folder & "Material Request - " & Sheets("Input data").Range("name").Value & "_" & Sheets("Input data").Range("date").Value & " " & Sheets("Input data").Range("time").Value & ".pdf"
Sheets("Material Request").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName 'OpenAfterPublish:=True`
You should start with changing the code to remove .Select & .ActiveSheet instances.
Dim oWS as Worksheet
Set oWS = ThisWorkbook.Worksheets("Input data")
' Worksheets("Input data").Visible = True
folder = oWS.Range("location").Value
If Right(folder,1) <> Application.PathSeparator Then folder = folder & Application.PathSeparator
MyTime = Time
' Sheets("Input data").Select
oWS.Range("G2").Value = MyTime
strFileName = folder & "Material Request - " & oWS.Range("name").Value & "_" & oWS.Range("date").Value & " " & oWS.Range("time").Value & ".pdf"
Debug.Print "strFileName: " & strFileName
'Sheets("Material Request").Select
oWS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName 'OpenAfterPublish:=True`
Set oWS = Nothing
Refer to this MSDN Worksheet.ExportAsFixedFormat Method, you may need fill in more parameters depending on properties of the Worksheet "Input Data".
I have added some checks and refer to Immediate window to check value of strFileName in 2007.
I had a similiar problem (Error 1004 when attempting export). After an hour of pulling my hair out, here was the source of my problem.
I was passing a cell value as part of generating the filename. I was doing this in the format of
fileName:= ActiveWorkbook.Path & "\" & CStr(Workbooks.Cells(i,j).Value) & ".pdf"
The text in the cell itself was formatted to be in two rows (i.e. "top row text" + (Alt+K) + "bottom row text"). While the string looks normal in Debug.print, MsgBox, or value previews, I am thinking that there is a hidden character which encodes the new line for the cell. I believe this hidden character causes the error when passed as part of the fileName argument. I'm guessing Excel doesn't pick it up but the OS's file name system does.
In any case, this fixed the issue for me.