I'm trying to create an Excel macro that exports worksheets to PDF. I have a simple piece of code below that successfully exports the active sheet to the folder that I want. What I want to do - and can't find a solution for - is a way to give the user the option to export multiple worksheets to the same PDF. In my application the worksheets exported may have different names, may be created after the macro is written and may be a different number of sheets each time. I have tried to make arrays that use selection but this is beyond my own knowledge of macro writing, which is limited. In an ideal world, I'd like to use a pop-up selection box to choose the sheets to export, but I'll start with the basics of the code first.
Could someone please suggest a section of code that would suit my application?
Sub Export_PDF()
'File name
Dim saveName As String
saveName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "pdf"
'File path
Dim saveLocation As String
saveLocation = "C:\Users\" & Environ("username") & "\Temp Out\"
'Save Active Sheet(s) as PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=saveLocation & saveName
End Sub
Excel stores worksheets as a collection, so you can easily access all the worksheets that have been created in the workbook.
To allow user to select which ones he wants to export, you can create a UserForm with a ListBox that will read all available worksheets in the workbook and display them. Sample code that does that below (the UserForm has only one listbox created ListBox1 and nothing else).
Sub export_wsheets()
Dim wsheet As Worksheet
Dim wsheets_col As worksheets
Dim uForm As New UserForm1
Set wsheets_col = ThisWorkbook.worksheets
For Each wsheet In wsheets_col
uForm.ListBox1.AddItem wsheet.Name
Next
uForm.Show
End Sub
From then on you can just save user's choice and loop through the workbooks again exporting the ones that were selected. You can access particular worksheet by using it's name or ID.
It's not a complete solution but I hope it sheds some more light on your problem.
Related
I use this piece of code:
Application.Workbooks(V_WBNameOutPut).Activate
to activate a particular excel file, I notice that this method goes in error if the "File name extension" (in the View tab of the Folder Menu) is flagged.
In order to be independent of this, what modification should I do/include to the code or what alternative method should I use?
This answer is based on the comment
I interchange many times during the macro run between 2 workbooks, input and output
excel files, and I need to activate the V_WBNameOutPut, to paste and elaborate, and > this is done multiple times during the run. From the input file, I create the > V_WBNameOutPut file.
As #brax said - capture the workbook when it's opened and you don't have to worry about the extension after that.
Sub Test()
'Open the first workbook and store reference to it.
Dim wrkBk1 As Workbook
Set wrkBk1 = Workbooks.Open("H:\Darren Bartrup-Cook\Test 1.xlsx")
'Open the second workbook and store reference to it.
Dim wrkBk2 As Workbook
Set wrkBk2 = Workbooks.Open("H:\Darren Bartrup-Cook\Test 2.xlsx")
'Copy/paste from wrkbk1 to wrkbk2.
wrkBk1.Worksheets("Sheet1").Range("A1").Copy Destination:=wrkBk2.Worksheets("Sheet1").Range("A4")
'Create a new sheet in wrkbk2.
Dim NewWrkSht As Worksheet
Set NewWrkSht = wrkBk2.Worksheets.Add
NewWrkSht.Name = "My New Sheet"
'Paste copy/paste values from wrkbk1 to wrkbk2.
wrkBk1.Worksheets("Sheet1").Range("A2").Copy
NewWrkSht.Range("A5").PasteSpecial Paste:=xlPasteValues
'Make A3 in wrkbk2 equal the value in wrkbk1 A3.
wrkBk2.Worksheets("Sheet1").Range("A3") = wrkBk1.Worksheets("Sheet1").Range("A3")
'Close the two workbooks.
wrkBk2.Close SaveChanges:=True
wrkBk1.Close SaveChanges:=False
End Sub
I have a huge Excel spreadsheet that I need to allow access to a large set of users so they can manipulate it for their customers, but I don't want them to be able to overwrite the original file (a variable easily set in Excel) or save their file outside the current folder - so I want to force them in a "saveas" mode, and force the file to be saved in that folder. Otherwise, they won't be able to save. I'm not much of a VBA person, and I've found a lot of examples that may work, but nothing seems to be exactly what I need or maybe I'm not smart enough to figure it out. I found this code, but I'm not sure it FORCES the issue. Help?
I've tried to manage this in GPOs but everything seems to give them access to download the folder and save in other places.
Sub ExampleToSaveWorkbookSet()
Dim wkb As Workbook
'Adding New Workbook
Set wkb = Workbooks.Add
'Saving the Workbook
wkb.SaveAs "C:\WorkbookName.xls"
'OR
'wkb.SaveAs Filename:="C:\WorkbookName1.xls"
End Sub
Expected output is the amended Excel file saved in the original directory with a different name, or not at all.
Here's a macro that runs on open and immediately saves as .xlsx to a user location you can specify. Unfortunately the original needs to be .xlsm to store a macro.
This macro is to be located in the "ThisWorkbook" object. It will exit before making a copy when you open the workbook.
Private Sub Workbook_Open()
Dim wb As Workbook
Set wb = ActiveWorkbook
vWbName = wb.Name
vUserProf = Environ("USERPROFILE")
vx = InStr(1, vUserProf, "Users\")
If "<Use your own profileID>" = Mid(vUserProf, vx + 6) Then Exit Sub
vDir = vUserProf & "\Downloads\"
vWbName = Left(vWbName, Len(vWbName) - 5) & ".xlsx"
wb.SaveAs vDir & vWbName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
MsgBox "You are now using a copy of the original"
End Sub
I'm still reasonably new to VBA and feel I'm punching a little above my weight, so hopefully someone can help.
I need to issue a spreadsheet to people in my company which they can fill out and send it back. This needs to be done multiple times, so I have tried to automate this as much as possible. The source data is pasted in an "input" tab - this is then pivoted by user and input into a template tab. I can select any user and run a macro which does this and exports the filled out template to a new workbook.
In this template tab, I have dependent drop-down lists, which I have done by data validation - this relies on named ranges from the "coding" tab, which is also exported. One named range shows a list of values, and the other indexes over this and matches it to the required cell, to ensure only valid combinations are shown.
My issue is that the new workbook must not contain any links to the master - it should function completely in its own right. However, something is going wrong with the data validation/named ranges. Either some named ranges are being deleted (I know which bit of code is doing that but without it you get prompted to update links) or the data validation formula links back to the original workbook and doesn't work. I cannot find another way of achieving what I need without this particular data validation set up, so I need to try and adjust my macro to cater for this.
Is it possible to simply copy the template and coding tabs, with all the data validation, to a new workbook and break all links to the original, so that there are no startup prompts and the drop-downs all work?
Sub Copy_To_New_Workbook()
Dim wb As Workbook
Dim name As String
Dim ExternalLinks As Variant
Dim x As Long
Dim strFolder As String, strTempfile As String
name = Worksheets("Control").Cells(14, 7).Value
Let FileNameIs = Range("Filepath").Value & Range("FileName").Value
Set wb = Workbooks.Add
ThisWorkbook.Worksheets("Coding").Copy Before:=wb.Sheets(1)
ActiveSheet.name = "Coding"
ThisWorkbook.Worksheets("Transactions").Copy Before:=Worksheets("Coding")
ActiveSheet.name = "Transactions"
With ActiveSheet.UsedRange
.Value = .Value
End With
Application.DisplayAlerts = False
Worksheets("Sheet1").Delete
Application.DisplayAlerts = True
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
For x = 1 To UBound(ExternalLinks)
wb.BreakLink name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
Next x
Dim objDefinedName As Object
For Each objDefinedName In wb.Names
If InStr(objDefinedName.RefersTo, "[") > 0 Then
objDefinedName.Delete
End If
Next objDefinedName
On Error GoTo 0
wb.SaveAs Filename:=FileNameIs, FileFormat:=52
ActiveWorkbook.Close
End Sub
A non-IT related class has been assigned a group project where the work they do will be stored is a single .xlsx file. The members decided the best way to collaboratively edit said file would be to split it into its constituent sheets, upload each *.xlsx sheet to an SVN repository, and use locks and a .txt file to organize sheet/member responsibility.
The group has accomplished the splitting of said files with a VB script (courtesy of this wonderful site) which was as follows:
Sub SaveSheets()
Dim strPath As String
Dim ws As Worksheet
Application.ScreenUpdating = False
strPath = ActiveWorkbook.Path & "\"
For Each ws In ThisWorkbook.Sheets
ws.Copy
'Use this line if you want to break any links:
BreakLinks Workbooks(Workbooks.Count)
Workbooks(Workbooks.Count).Close True, strPath & ws.Name & ".xlsx"
Next
Application.ScreenUpdating = True
End Sub
Sub BreakLinks(wb As Workbook)
Dim lnk As Variant
For Each lnk In wb.LinkSources(xlExcelLinks)
wb.Breaklink lnk, xlLinkTypeExcelLinks
Next
End Sub
Therewith the group now has a repository where each member is currently in the process of editing their respective files. The question then is, how can we automate the re-unification of these files into one .xlsx file with the preservation of the original links.
EDIT 4/2: started bounty // I'm aware that the links were "broken" by the above script but am not exactly sure what this means though I suspect it would make re-assembly with the preservation of original links more difficult. It should be noted that the original file which had the links is still available and might could be used to assist with this problem.
EDIT 4/2: Excel version is 2010--original links do not exist in current files.
EDIT 4/3: Original links are not in the current files, but it is desired that with the re-unification the original links (from original unedited file, pre-splitting) be re-created/preserved.
If you have SharePoint, you can all update the same Excel (2003 or 2010) book.
http://office.microsoft.com/en-us/excel-help/about-shared-workbooks-HP005262294.aspx
The links then don't really apply in the solution, as you said the original doesn't have any links and so reassembly with links isn't required.
The script provided even has a comment embedded saying "Use this line if you want to break any links:". So if you comment the line below out (prepend the line with a ') it will preserve the links in the child workbooks.
Using the answer to a previous question on copying sheets to another workbook reassembly can be accomplished with the following VBA:
Sub CombineSheets()
Dim strPath As String
Dim ws As Worksheet
Dim targetWorkbook As Workbook
Set targetWorkbook = ActiveWorkbook
Application.ScreenUpdating = False
'Adjust path location of split files
strPath = "C:\code\xls-split"
Dim str As String
'This can be adjusted to suit a filename pattern.
str = Dir(strPath & "\*.xl*")
Do Until str = ""
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(strPath & "\" & str, UpdateLinks:=0)
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
Next Sheet
wbResults.Close SaveChanges:=False
str = Dir()
Loop
Application.ScreenUpdating = True
End Sub
This will append the other workbooks to the currently opened workbook.
Sourced Replacing FileSearch function for code to find xls files in a directory.
We probably need more detail in order to help you, but you may be able to accomplish what you need as follows (maybe this can kick-start a solution):
Loop through the sheets in the workbook
For each sheet
Open the appropriate xlsx file
Identify non-formula cells
For each of those cells
Copy to the identical location in the main workbook
Close the xlsx file
Below is an example (based on your SaveSheets code). If you try this, be sure to backup everything first. We obviously don’t know how the spreadsheets are laid out and how they are used. It would really suck if it got all screwed up. Also, there are some assumptions:
The layout and used range in the xlsx files are the exact same layout and used range as it appears in the original workbook.
The links you are referring to are formulas (either to another sheet or another workbook).
If these assumptions are wrong, you will need to modify as appropriate (identifying specific ranges to copy and/or adding more robust logic to the routine).
Note that the actual code to do this is very short. I added comments and basic error handling which significantly increased the amount of code.
This code would be added to the original workbook.
Sub RetrieveSheets()
Dim strPath As String
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim wbk As Workbook
Dim rng As Range
Application.ScreenUpdating = False
strPath = ActiveWorkbook.Path & "\"
For Each ws In ThisWorkbook.Sheets
'Open the xlsx file (read only)
Set wbk = Nothing
On Error Resume Next
Set wbk = Workbooks.Open(strPath & ws.Name & ".xlsx", ReadOnly:=True)
On Error GoTo 0
'Continue if xlsx file was successfully opened
If Not wbk Is Nothing Then
Set ws2 = Nothing
On Error Resume Next
Set ws2 = wbk.Worksheets(ws.Name)
On Error GoTo 0
'Continue if appropriate sheet was found
If Not ws2 Is Nothing Then
'Identify cells to copy over (cells that are constants)
For Each rng In ws2.Cells.SpecialCells(xlCellTypeConstants)
'set the cell value equal to the identical cell location in the xlsx file
If (Left(ws.Range(rng.Address).Formula, 1)) <> "=" Then
ws.Range(rng.Address) = rng
End If
Next
Set ws2 = Nothing
End If
'Close the xlsx file
wbk.Close False
End If
Next
Set wbk = Nothing
Application.ScreenUpdating = True
End Sub
This is a rough outline of how I accomplished this:
Use Office2013 and not office 2010
create tmp/ directory with original .xlsx assignment file.
create source/ directory in tmp/
use split sheets module (listed on this page), but comment out the line that break links.
place all of the resulting .xlsx files into source/ (you can delete the original .xlsx file)
remote the first sheet from the sources/ folder, and place it ../
Open this first sheet, and import/use the 'combinesheets' module listed on this page.
Save the sheet, reopen it and you'll be prompted to update links. Do so, and select "change source" and select the first sheet Re in step 6.
links will automatically update; done.
Notes: you'll have to save a file as macro enabled, ...
Take a look at this MSDN Article on Merging Data from multiple workbook (.xls/.xlsx) files
http://msdn.microsoft.com/en-us/library/office/gg549168%28v=office.14%29.aspx
I don't know much about VBA but I think this is what you are looking for.
Also note it does get rid of the need for a text file to manage the files
I would like to know if it is possible (AND HOW) to create a Excel template with a specific Macro to use this Macro automatically at Spreadsheets we are exporting from our measurement hardware.
We export the measurements from our hardware into an Excel Spreadsheet. Now we have to write for every Spreadsheet the same Macro to filter specific criteria we only need.
So we would like to have one Excel Template with this Macro saved in it, to import the Excel Spreadsheet from our hardware so it automatically filters the criteria every time, so we can use it immediately.
How can we arrange this?
If a assume your measurement hardware always produce the same output file name...
1 - You could have a template with the macro that imports and filter your data file.
In this scenario, the file with the macro would not server as a template per see
Sub LoadDataSheet()
Dim sWbkPath As String
sWbkPath = "PATH_TO_FILE\" & "FILE_NAME"
Dim wbkData As Workbook
Set wbkData = Workbooks.Open(sWbkPath)
DataFilteringMacro wbkData 'or sheet
End Sub
2 - You could have an addin that shows a ribbon only when the data file is open
In the "ThisWorkbook" module...
Dim WithEvents App As Application
Private Sub Workbook_Open()
Set App = Application
End Sub
Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
'...
'if using a ribbon, you could put the code in the "GetVisible" callback
'and invalidate the ribbon in the App_WorkbookActivate()
'bVisible is the value set in the ribbon callback
Dim wbk As Workbook
Set wbk = ActiveWorkbook
If wbk.Name = "FILE_NAME" Then
'bVisible = True 'the data file was loaded
Else
'bVisible = False 'another file was loaded
End If
End Sub