I know absolutely nothing about VBA, I'm just trying to have 4 charts (that are already separated in their own tabs) be seamlessly exported as PNG files to a prespecified location every time I save an excel document.
Going through some of stackoverflow's database I managed to do something similar with a worksheet that I wanted to export as a CSV, but I can't manage to do the same for my charts.
Right now thats what my VBA looks like for ThisWorkbook:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("CSV Monthly Update").Copy
ActiveWorkbook.SaveAs Filename:="CSV Monthly Update.csv", FileFormat:=xlCSVWindows
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
'This above part works well'
'The one below doesn't, I'm trying to get the chart from Worksheet "Growth_of_10k" to be exported but it gives me a Runtime error 9 about runscript being out of page'
Sub ExportChart()
Dim objChrt As ChartObject
Dim myChart As Chart
Set objChrt = Sheets("Growth_of_10k").ChartObjects(3)
Set myChart = objChrt.Chart
myFileName = "myChart.png"
On Error Resume Next
Kill ThisWorkbook.Path & "\" & myFileName
On Error GoTo 0
myChart.Export Filename:=ThisWorkbook.Path & "\" & myFileName, Filtername:="PNG"
MsgBox "OK"
End Sub
Any idea how I would need to change the code so that the chart is exported automatically to the same location as the file (or another pre-specified location, it doesn't matter) at the same time as I save the excel document?
I'm sorry if this is a newbie question, this is really my very first endeavor with VBA and googling can only get you so far when you don't understand what you're doing.
Thanks a ton in advance.
A chart sheet is different from a chartobject embedded on a worksheet.
Thisworkbook.Sheets("Chart1").Export _
Filename:=ThisWorkbook.Path & "\" & myFileName, Filtername:="PNG"
Related
I tried to read up a few related posts on the forum but wasnt able to make a code work or understand the syntax of a few functions.
I will try to describe what I want to be done in a crisp fashion:
I have a workbook with the multiple sheets (Sheet1, Sheet2 ... Sheet 5) and I want to create a macro assigned button to Save as a new work book containing only Sheet 1, Sheet 2 and Sheet3
The file format should be Microsoft Excel 97-2003 Worksheet (.xls)
On clicking the Macro assigned button the Save as dialogue box should pop up allowing the user to select destination and also optionally a new file name (pre assigned file name can be "textstring123"
After the workbook is saved the workbook should open for user to inspect while the old workbook is minimised
I am using Excel 2013, in case that is relevant.
The post may seem crude but I have no choice but to seek help from you as I have been breaking my head over this for the last day and a half and without this the rest of my macro project will become a waste. Thank you in advance for and suggestion/advice/ help.
If any other details or clarification is required please do ask.
I have added my lines of code that I have made but doesnt seem to work properly.
Sub Macro6()
'
' Macro6 Macro
' Save as
''
Dim varResult As Variant
Sheets(Array("sheet1", "sheet2", "sheet3")).Copy
varResult = Application.GetSaveAsFilename(FileFilter:= _
"Excel Files *.xls", FileFormat:=-57, Title:="Save File", _
InitialFileName:=ActiveWorkbook.Path \ Textstring123.xls)
If varResult <> False Then
ActiveWorkbook.SaveAs Filename:=varResult, _
FileFormat:=xlWorkbookNormal
Exit Sub
End If
End Sub
This will do the trick, I have an issue with the Filters so I added a bit of error handling!
Option Explicit
Sub Macro6()
'
' Macro6 Macro
' Save as
''
Dim tB As Excel.Workbook
Dim wB As Excel.Workbook
Dim ExportArray As Variant
Dim ShName As Variant
Dim ExportName As String
Dim varResult As Variant
Set tB = ThisWorkbook
ExportArray = Array("sheet1", "sheet2", "sheet3")
For Each ShName In ExportArray
Debug.Print ShName
tB.Sheets(ShName).Copy
Set wB = ActiveWorkbook
On Error Resume Next
ExportName = Application.GetSaveAsFilename(tB.Path & "\Textstring123", "Excel Files *.xls", , "Save " & ShName)
If Err.Number > 0 Then
ExportName = Application.GetSaveAsFilename(tB.Path & "\Textstring123", , , "Save " & ShName)
Else
'No error, everything went well with filters
End If
On Error GoTo 0
'String 8 and Boolean 11
If VarType(ExportName) <> 8 Then
Exit Sub
Else
wB.SaveAs Filename:=ExportName, FileFormat:=xlWorkbookNormal
End If
DoEvents
wB.Close
Next ShName
End Sub
In the automation tool trainer has to mention student names and using that name the Excel file will be created. Example: Shreesha_xlsx.xlsx
After assigning the test with their names, IF the students open the Excel file of their own, THEN they should be able to see the userform (Welcome screen) and next screen is answering the questions.
The following code is that to assign the Excel file under the student name and after that I have also pasted the code that when user clicks on the Excel file it should open with userform.
Altogether it is calling userform of one Excel file in another without setting any reference.
Sub Button2_Click()
Dim s(6 To 100) As String
Dim stname As String
Dim status As String
Dim mypath As String
Dim u As String
u = "_xlsx"
For i = 6 To 100
s(i) = Range("E" & i).Value
stname = s(i) & "" & u
If s(i) = "" Then
ActiveWorkbook.Open = False
End If
'in case of Run time error
On Error GoTo jamun:
mypath = Range("B1").Value & "\" & stname
Workbooks.Add.SaveAs filename:=mypath
ActiveWorkbook.Close
Range("B" & i).Value = mypath & "_assigning..."
Application.Wait Now + TimeValue("00:00:02")
Range("F" & i).Value = "Done"
Range("B" & i).Value = mypath & "_assigned"
Range("B" & i).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="mypath", TextToDisplay:=Range("B" & i).Value
Range("B" & i).Select
Selection.Hyperlinks(1).Address = Range("B1").Value
Application.Wait Now + TimeValue("00:00:01")
Next
MsgBox "Test assigned successfully"
Exit Sub
jamun:
MsgBox "Test assigned successfully"
End Sub
Now the following code is that when they open, they should see the userform
enter code here
Sub Workbook_Open()
Dim FSO As New FileSystemObject
Dim objFolder As Folder
Dim objFile As File
Dim strpath As String
Dim a As Workbook
Dim filename As String
strpath = Range("B1").Value
Set objFolder = FSO.GetFolder(strpath)
If objFolder.Files.Count = 0 Then
MsgBox "No files were found....", vbExclamation
End If
For Each objFile In objFolder.Files
a = "Good" 'userform name is good
Workbook.Open (a)
VBA.UserForms.Add(a).Show
a.Show
Next objFile
End Sub
and don't know where I am going wrong.
1) Create an excel workbook with the desired form
2) Write code to open the form on Workbook_Open()
3) Write code in the form to fill the workbook with questions and whatever other information when the WB opens. All in all, make the behavior of the file exactly as you want it to behave when it opens to the student.
4) Save your file as a template (extension .xltm), let's say examTemplate.xltm
5) Now when you will generate exam files from the master file, generate them from the template. Consider changing this part of your code:
Workbooks.Add.SaveAs filename:=mypath
ActiveWorkbook.Close
Instead of this, we generate the file from the template:
Dim neWB as Workbook
Set newWB = Workbooks.Add("examTemplate.xltm") ' <~~~ generate from template
The freshly generated newWB inherits the template. That is, it has all its data, code, controls and forms. At this point, you can fill some data in newWB, things related to the assignment. That is, questions, or some parameters that will indicate where to fetch the questions, so that the form can access these parameters and do the work. Ideally, these parameters can be embedded in a hidden sheet. After then:
newWB.SaveAs filename:=mypath ' <~~ save it as macro-enabled .xlsm
newWB.Close
From that point, I think you can continue with with the same logic. The radical change in the approach is that the form will be readily embedded in the new workbook, not invoked from another workbook.
EDIT: you want your workbook to only show only the Form but never the workbook itself. This can be achieved by adding the following event handler to the ThisWorkbook code module of your template file:
Private Sub Workbook_Open()
If InStr(1, Me.Name, ".xltm") > 1 Then Exit Sub ' <~~ to apply only to chidren no to template itself
With Me.Application
.Visible = False
.DisplayAlerts = False
MyForm.Show
.Visible = True
End With
Me.Close
End Sub
The following VBA snippet works correctly on one machine with Excel version
"Microsoft(R) Office Excel(R) 2007 (12.0.6727.5000) SP3 MSO (12.0.6728.5000)"
but not on one with
"Microsoft(R) Office Excel(R) 2007 (12.0.6729.5000) SP3 MSO (12.0.6728.5000)"
Breaking and single-stepping indicates that the wSheet is iterating over the known worksheets, but the exported files only contain the contents of the first worksheet - i.e. sheet1.csv, sheet2.csv, sheet3.csv are all saved, but each one contains the contents of sheet1 from the workbook.
A separate "macro" that only saves the active worksheet behaves identically - no matter which worksheet is active at the time the "macro" is invoked, only the data from the first worksheet is saved, though into a file named as the active worksheet. The DBPrint statement also shows that the wSheet is iterating over the worksheets. (DBPrint is just a Debug.Print with an on/off switch.)
For Each wSheet In ActiveWorkbook.Worksheets
wSheet.Activate
wSheetName = wSheet.Name
SaveAsName = wBookName & "." & wSheetName & ".csv"
DBPrint "saving as " & SaveAsName
On Error Resume Next
wSheet.SaveAs filename:=SaveAsName, FileFormat:=xlCSV
' ... error handling code (no errors reported, though)
On Error GoTo 0
Next wSheet
My workaround:
Dim Workbook1 As Workbook
Set Workbook1 = ActiveWorkbook
For Each wSheet In Workbook1.Sheets
SaveAsName = wBookName & "." & wSheet.Name & ".csv"
DBPrint "saving as " & SaveAsName
wSheet.Copy After:=Workbook1.Sheets(Workbook1.Sheets.Count)
Workbook1.Sheets(Workbook1.Sheets.Count).Move
ActiveWorkbook.SaveAs filename:=SaveAsName, FileFormat:=xlCSV
ActiveWorkbook.Close False
Next wSheet
Try that and let me know if it works.
I had the same problem and, for a while, used #puzzlepiece's workaround. It worked well but became a bit slow as the datasets I have to use became bigger.
Luckily, I found a fix that does not require copying and moving: https://www.extendoffice.com/documents/excel/628-excel-split-workbook.html
Sub Splitbook()
'Updateby20140612
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
xWs.Copy
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I am trying to come up with code that will make copies of all the worksheets in a given workbook. Seems simple enough, right? A little Google searching and I cobbled together the following code:
Sub Commandbutton1_click()
Dim Cnt As Long
Dim i As Long
Dim Sht1 As String
Dim MyChoice As String
Dim MyFile As String
Dim CurrWorkBook As Excel.Workbook
Dim Month As String
'Instructional message box
MsgBox "When the 'Open' dialog appears, select the workbook containing the worksheets you want to split and then click Ok."
'Get file name
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Show
MyChoice = .SelectedItems(1)
End With
Application.ScreenUpdating = False
MyFile = Dir(MyChoice)
Set CurrWorkBook = Workbooks.Open(Filename:=MyFile)
CurrWorkBook.Activate
Cnt = Sheets.Count
InputMsg = "Enter the month of the EOM Budget Review:"
InputTitle = "Month"
Month = InputBox(InputMsg, InputTitle)
For i = 1 To Cnt Step 1
Sht1 = Sheets(i).Name
Sheets(Array(Sht1)).Copy
ActiveWorkbook.SaveAs Filename:=Sht1 & " - " & Month & " EOM Budget Review.xlsx", _
FileFormat:=51, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Next i
CurrWorkBook.Save
CurrWorkBook.Close
Application.ScreenUpdating = True
End Sub
It works perfectly...except when it doesn't. In some workbooks, it will copy every sheet with no difficulty. In some workbooks, it will copy some of the sheets, but throw the "Copy method of Sheets class failed" unless you have it skip certain sheets. I have not been able to figure out what the sheets it will not copy have in common. Is there some way I can improve this code? Are there certain features of worksheets that will cause this kind of code to fail inevitably?
Solved thanks to Alex P.'s comment above. I copied the following code from another forum:
Sub UnhideAll()
Dim WS As Worksheet
For Each WS In Worksheets
WS.Visible = True
Next
End Sub
Then I used Call UnhideAll right after Application.ScreenUpdating = False. I also used CurrWorkBook.Close savechanges:=False at the end so that the workbook being copied would not be saved and its hidden worksheets would go back to being hidden.
I am working on writing a VBA code to export some of the sheets in excel to same PDF. I have several chart sheets in my excel file each of which name ends with "(name)_Chart".
I want to export all sheets with names ending wioth chart to one PDF file.
Here is the code I am trying to write.
Sub FindWS()
'look if it at least contains part of the name
Dim s As Worksheet
Dim strPath As String
strPath = ActiveWorkbook.Path & "\"
For Each s In ThisWorkbook.Sheets
If InStr(1, s.Name, Chart) Then
s.Activate
ActiveSheet.ExportAsFixedFormat xlTypePDF, strPath & s.Name & ".pdf"
Exit Sub
End If
Next s
End Sub
This code is not limting export to only the chart sheets but exporting thy whole workbook. Can anyone help me with figurint out whats is missing in my code.
Thanks!
MODIFIED CODE:
Sub FindWS()
'look if it at least contains part of the name
Dim s As Worksheet
Dim strPath As String
strPath = ActiveWorkbook.Path & "\"
For Each s In ThisWorkbook.Worksheets
If InStr(1, s.Name, "Chart") = 0 Then
' Hide the sheet so it is not exported as PDF
s.Visible = False
End If
Next s
With ActiveWorkbook
.ExportAsFixedFormat xlTypePDF, strPath & "TEST.pdf"
End With
End Sub
I am surprised that your code is running in the first place :) You should have actually got an error run time error '13', type mismatch
Sheets and Worksheets are two different things in Excel
The Worksheets collection is a collection of all the Worksheet objects in the specified or active workbook. Each Worksheet object represents a worksheet. Whereas the Sheets collection, on the other hand, consist of not only a collection of worksheets but also other types of sheets to include Chart sheets, Excel 4.0 macro sheets and Excel 5.0 dialog sheets.
So if you declare your object as Worksheet
Dim s As Worksheet
Then ensure that while looping you loop through the correct collection
For Each s In ThisWorkbook.Worksheets
and not
For Each s In ThisWorkbook.Sheets
else you will get a run time error '13', type mismatch
FOLLOWUP (Based on Comments)
# Siddharth: 1. Yes, I want to export Chart sheets that ends with name "Chart". 2. I want all those charts in one PDF and the name of the PDF should be the "original" file name. (I will have to save the final PDF files in different location so there will be no overlapping of files.) – datacentric
Option Explicit
Sub Sample()
Dim ws As Object
Dim strPath As String, OriginalName As String, Filename As String
On Error GoTo Whoa
'~~> Get activeworkbook path
strPath = ActiveWorkbook.Path & "\"
'~~> Get just the name without extension and path
OriginalName = Left(ActiveWorkbook.Name, (InStrRev(ActiveWorkbook.Name, ".", -1, vbTextCompare) - 1))
'~~> PDF File name
Filename = strPath & OriginalName & ".pdf"
'~~> Loop through Sheets Collesction
For Each ws In ActiveWorkbook.Sheets
'~~> Check if it is a Chart Sheet and also it ends in "Chart"
If ws.Type = 3 And UCase(Right(Trim(ws.Name), 5)) = "CHART" Then
ws.Visible = True
Else
ws.Visible = False
End If
Next ws
'~~> Export to pdf
ActiveWorkbook.ExportAsFixedFormat xlTypePDF, Filename
LetsContinue:
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
This code will look through all the sheets. If the sheet name doesn't match it will hide it. When it's finished that it exports all visible sheets into one PDF. Make sure yuo don't save the Excel file afterwards or the sheets will remain hidden.
Of course this code is not tested so if you have issues ask back (or try and resolve themself as you may learn something)
Sub FindWS()
'look if it at least contains part of the name
Dim s As Worksheet
Dim strPath As String
strPath = ActiveWorkbook.Path & "\"
For Each s In ThisWorkbook.Sheets
If InStr(1, s.Name, "Chart") = 0 Then
' Hide the sheet so it is not exported as PDF
s.Visible = False
End If
Next s
' Export all sheets as PDF
ActiveSheet.ExportAsFixedFormat xlTypePDF, strPath & "TEST.pdf"
End Sub