Private Sub Workbook_Open()
Dim SourceList(0) As Workbook
Dim PathList() As String
Dim n As Integer
PathList = Split("\data\WeaponInfo.csv", ",")
ThisWorkbook.Activate
Application.ActiveWindow.Visible = False
Application.ScreenUpdating = False
For n = 0 To Ubound(PathList)
Workbooks.Open Filename:=ThisWorkbook.Path & PathList(n)
Set SourceList(n) = ActiveWorkbook
ActiveWindow.Visible = False
Next
Application.ScreenUpdating = True
Workbooks.Open Filename:=ThisWorkbook.Path & "\HeroForge Anew 3.5 v7.4.0.1.xlsm", UpdateLinks:=3
ActiveWindow.Visible = True
Application.DisplayAlerts = False
For n = 0 To UBound(SourceList)
SourceList(n).Close
Next
Application.DisplayAlerts = True
End Sub
The line For n = 0 to PathList.GetUpperBound(0) is throwing a "Compile Error (invalid qualifier) whenever I try to run this macro. Specifically it highlights PathList as being the problem.
Also, if I cut out the loop and just have the contents run once (replacing the PathList(n) with "\data\WeaponInfo.csv"), it throws an "Object Variable or With block variable not set" error on the SourceList(0) = ActiveWorkbook line. What am I doing wrong?
I'm aware that the loop is currently pointless; it's futureproofing as I'm going to be using this macro to open multiple data references.
EDIT: Made changes suggested by #Jeremy below, now getting the "Object variable or With block variable not set" error on the SourceList(n).Close line.
EDIT2: Fixed the loop, again on the advice of #Jeremy, by changing Dim SourceList(1) As Workbook to Dim SourceList(0) As Workbook
A couple of issues:
In VBA, the GetUpperBound method does not exist, it is for .NET only. Change it to Ubound function.
You may run into a problem with Sourcelist(0) = ActiveWorkbook. Use the Set keyword when assigning object references.
Source is not defined in your loop. ALWAYS put Option Explicit at the top of your code module to force you to declare your variables. It will save pain in the future.
What are you trying to do with splitting that string? you will just get one value, which is the string you are passing in.
Private Sub Workbook_Open()
Dim SourceList(1) As Workbook
Dim PathList() As String
Dim n as Integer
PathList = Split("\data\WeaponInfo.csv", ",")
ThisWorkbook.Activate
Application.ActiveWindow.Visible = False
Application.ScreenUpdating = False
For n = 0 To Ubound(PathList)
Workbooks.Open Filename:=ThisWorkbook.Path & PathList(n)
Set SourceList(0) = ActiveWorkbook
Next
ActiveWindow.Visible = False
Application.ScreenUpdating = True
Workbooks.Open Filename:=ThisWorkbook.Path & "\HeroForge Anew 3.5 v7.4.0.1.xlsm", UpdateLinks:=3
ActiveWindow.Visible = True
For Each Source In SourceList
Source.Close
Next
End Sub
Related
it's me, again.
I have a code that import a reference sheet on wb_open. Im trying something new to get my code faster but it's creating a problem.
My new code delete (instead of copi-pasting) the existing internal Ref sheet and replace is by the external (refreshed or not) one.
The problem comes from the fact that deleting the internal ref sheet deletes my in-cell reference to that sheet even tho im naming the newly copied sheet the exact same name. Is there a way to get around?
Sub Workbook_open()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim Sheetname As String
Sheetname = "cédule détaillée 2 "
Worksheets(Sheetname).Visible = True
Dim externalwb As Workbook
Set externalwb = Workbooks.Open(fileName:="\\Backup\Opérations\Coaticook\Planification\Cédule détaillées\Cédule détaillées des composantes.xlsx")
Dim curentSheetNumber As Long
currentSheetNumber = ThisWorkbook.Worksheets(Sheetname).Index
ThisWorkbook.Worksheets(Sheetname).Delete
externalwb.Worksheets(Sheetname).Copy After:=ThisWorkbook.Worksheets(currentSheetNumber - 1)
externalwb.Close False
Worksheets(Sheetname).Visible = False
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Try implementing the next formula copying approach, please:
Sub testCopyFormulas()
Dim sh As Worksheet, rngForm As Range, shN As Worksheet
Set sh = ActiveSheet
Set rngForm = sh.UsedRange.SpecialCells(xlCellTypeFormulas)
Set shN = Worksheets.Add
shN.Range(rngForm.Address).Formula = rngForm.Formula
End Sub
And specifically in your code, try this approach:
'...your code...
Dim externalwb As Workbook, rngForm As Range
Set externalwb = Workbooks.Open(fileName:="\\Backup\Opérations\Coaticook\Planification\Cédule détaillées\Cédule détaillées des composantes.xlsx")
Dim curentSheetNumber As Long
Set rngForm = ThisWorkbook.Worksheets(Sheetname).SpecialCells(xlCellTypeFormulas)
currentSheetNumber = ThisWorkbook.Worksheets(Sheetname).Index
ThisWorkbook.Worksheets(Sheetname).Delete
externalwb.Worksheets(Sheetname).Copy After:=ThisWorkbook.Worksheets(currentSheetNumber - 1)
externalwb.Close False
ThisWorkbook.Worksheets(Sheetname).Range(rngForm.Address).Formula = rngForm.Formula
'...Your code...
I want to call a vba function from vbscript which has a parameter, I Know how to call a parameterized sub but having issue with function
Here is what I have tried, I tried the code here Calling vba function(with parameters) from vbscript and show the result , but this also didn't work, it gave an error as expected end of statement
Set xlObj = CreateObject("Excel.Application")
Set objWorkbook = xlObj.Workbooks.Open("E:\Headers.xlsm")
xlObj.Application.Visible = False
xlObj.Workbooks.Add
Dim result
result = xlObj.Application.Run("Headers.xlsm!Headers",filename)
xlFile.Close True
xlObj.Quit
this my vba function
Function Headers(filename As String) As String
Application.ScreenUpdating = False
Dim myWb As Workbook
Dim i As Integer
Dim flag As Boolean
Set myWb = Workbooks.Open(filename:=filename)
Dim arr
arr = Array("col1","col2")
For i = 1 To 2
If Cells(1, i).Value = arr(i - 1) Then
Headers = "True"
Else
Headers = "False , Not Found Header " & arr(i - 1)
Exit Function
End If
Next
myWb.Close
End Function
In your VBScript xlObj is set to be an application Set xlObj = CreateObject("Excel.Application"). That means xlObj.Application should be xlObj only.
In your VBScript Filename is not declared nor set to a value therefore it is empty. You need to define value to it.
Set xlObj = CreateObject("Excel.Application")
Set objWorkbook = xlObj.Workbooks.Open("E:\Headers.xlsm")
xlObj.Visible = False
xlObj.Workbooks.Add
Dim Filename 'declare filename and set a value to it
Filename = "E:\YourPath\Yourfile.xlsx"
Dim Result
Result = xlObj.Run("Headers.xlsm!Headers", Filename)
xlFile.Close True
xlObj.Quit
In your function you use Exit Function. This will stop the code immediately at this point, which means your workbook myWb will not be closed! It stays open because myWb.Close is never reached. Change Exit Function to Exit For to just exit the loop and continue to close the workbook.
Cells(1, i).Value is neither specified which workbook it is in nor which worksheet. This is not very reliable never call Cells or Range without specifying workbook and worksheet (or Excel will guess which one you mean, and Excel can fail if you are not precise).
Therfore I recommend to use something like myWb.Worksheets(1).Cells(1, i).Value if you always mean the first worsheet in that workbook. Alternatively if it has a defined name using its name would be more reliable: myWb.Worksheets("SheetName").Cells(1, i).Value
If you turn off ScreenUpdating don't forget to turn it on in the end.
Error handling in case filename does not exist would be nice to not break the function.
You can slightly improve speed by assuming Headers = "True" as default and just turn it False in case you find any non matching header. This way the variable is only set once to True instead of multiple times for every correct header.
Public Function Headers(ByVal Filename As String) As String
Application.ScreenUpdating = False
Dim flag As Boolean 'flag is never used! you can remove it
On Error Resume Next 'error handling here would be nice to not break if filename does not exist.
Dim myWb As Workbook
Set myWb = Workbooks.Open(Filename:=Filename)
On Error Goro 0 'always reactivate error reporting after Resume Next!!!
If Not myWb Is Nothing Then
Dim Arr() As Variant
Arr = Array("col1", "col2")
Headers = "True" 'assume True as default and just change it to False if a non matching header was found (faster because variable is only set true once instead for every column).
Dim i As Long 'better use Long since there is no benefit in using Integer
For i = 1 To UBound(arr) + 1 'use `ubound to find the upper index of the array, so if you add col3 you don't need to change the loop boundings
If Not myWb.Worksheets(1).Cells(1, i).Value = Arr(i - 1) Then 'define workbook and worksheet for cells
Headers = "False , Not Found Header " & Arr(i - 1)
Exit For '<-- just exit loop but still close the workbook
End If
Next i
Else
Headers = "File '" & Filename & "' not found!"
End If
Application.ScreenUpdating = True
myWb.Close
End Function
I'm trying to use VBA to concatenate a string inside a formula. If I only use the code below i'm not getting any errors but when i add the IFERROR together with the code I get a runtime error.
Is there any way to work around it?
text1 = "='C:\Users\JOHLA\\Desktop\Yield ark\Nyt-yield-ark\[Yield-Uge-"
text2 = ".xlsm]Scrap'!H7"
The code including string with IFERROR that gives runtime error is given below.
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim i As Integer
Dim preRange As Range
Dim path, filename1 As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set ws = ActiveWorkbook.Sheets("Sheet1")
Set preRange = ws.Range("E9:I17")
i = ws.Range("C1").Value
text1 = "=IFERROR('C:\Users\JOHLA\Desktop\Yield ark\Nyt-yield-ark\[Yield-Uge-"
text2 = ".xlsm]Scrap'!H7;0)"
With ws
For i = .Range("C1").Value To .Range("C1").Value + 4
debug.print text1 & i & text2
preRange = text1 & i & text2
Set preRange = preRange.Offset(0, 5)
Next i
End With
End Sub
Judging by your use of semicolon in your formula, it would suggest that you're using local settings which are not compatible with VBA.Formula
in this case, you either need to change the formula to use a comma or set the formula using FormulaLocal:
preRange.FormulaLocal = Replace(text1 & i & text2, "'", Chr(34))
As you can see, I've also added a Replace that changes ' into " - as I think you need this also.
Lastly, don't forget to enable ScreenUpdating and DisplayAlerts at the end of your routine.
Any time you use
Application.ScreenUpdating = False
Application.DisplayAlerts = False
you need to make sure that you are using error handling to manage if your code breaks.
On Error GoTo ExitErr
Application.ScreenUpdating = False
Application.DisplayAlerts = False
<your code here>
ExitErr:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
This makes sure that if your code breaks (in your case the most obvious being someone renaming "Sheet1"), Excel isn't left with ScreenUpdating and DisplayAlerts left turned off. I can't tell you how many times I've had to fix other people's code because they turned off these functions and then couldn't figure out why Excel was acting up.
I am getting inconsistent results when I try to refer to an active workbook. About half the time I get the "Method of 'Sheets' of Object '_Global' not failed" error and other times the code works fine. I don't see a pattern.
The VBA code is part of a Word document that allows the user to open a template Excel file and select/copy text from the Word doc into rows on the Excel file.
In a previous sub I successfully open an Excel template file (I call it a RTM template). In the code below I want to activate the "RTM" worksheet, select the first cell where the template could already have data in it from a previous execution and if there is, then count how many rows of data exist. In this way the new data will be posted in the first row which does not have any data. I am using named ranges in my Workbook to refer to the starting cell ("First_Cell_For_Data").
When I run my code sometimes it runs without error and other times it stops on the "Sheets("RTM").Activate" and gives me the "Method...." error. The same result occurs when I change the variable definition of wb_open to Object. I have also tried using "wb_open.Sheets("RTM").Activate" with the same results.
As suggested in the comments below I added "If wb_open is nothing ...." to debug the issue. I also added the sub List_Open_Workbooks which enumerates the open workbooks (of which there is only 1) and activates the one that matches the name of the one with the correct filename. This is successful. But upon returning to Check_Excel_RTM_Template I still get the Method error on the "Sheets("RTM").Activate" line.
Second Update: after more time diagnosing the problem (which still occurs intermittently) I have added some code that may help getting to the root of the problem. In the "List_Open_Workbooks" sub I test for xlApp.Workbooks.Count = 0. So all references to an open Excel workbook will fail. At this point my template workbook is open in Windows. Am I drawing the correct conclusion?
Third Update: I tried Set wb_open = GetObject(str_filename) where str_filename contains the name of the Excel template file I just opened.
I get the following error message.
Also, I noticed that if I start with a fresh launch of Word and Excel it seems to run just fine.
Sub Check_Excel_RTM_Template(b_Excel_File_Has_Data As Boolean, i_rows_of_data As Integer)
Dim i_starting_row_for_data As Integer
Dim wb_open As Object
Set wb_open = ActiveWorkbook
i_rows_of_data = 0
If wb_open Is Nothing Then
MsgBox "RTM Workbook not open in Check_Excel_RTM_Template"
Call List_Open_Workbooks(b_Excel_File_Has_Data, i_rows_of_data)
Else
' On Error GoTo Err1:
' Sheets("RTM").Activate
' range("First_Cell_For_Data").Select
Workbooks(wb_open.Name).Worksheets("RTM").range("First_Cell_For_Data").Select
If Trim(ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(ActiveCell.Value) = ""
ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
End If
Exit Sub
Err1:
MsgBox getName(str_Excel_Filename) & " is not a RTM template file."
b_abort = True
End Sub
Sub to enumerate all open workbooks
Sub List_Open_Workbooks(b_Excel_File_Has_Data As Boolean, i_rows_of_data As Integer)
Dim xlApp As Excel.Application
Set xlApp = GetObject(, "Excel.Application")
Dim str_filename As String
Dim xlWB As Excel.Workbook
If xlApp.Workbooks.Count = 0 Then
MsgBox "Error: Windows thinks there are no workbooks open in List_Open_Workbooks"
b_abort = True
Exit Sub
End If
For Each xlWB In xlApp.Workbooks
Debug.Print xlWB.Name
str_filename = getName(str_Excel_Filename)
If Trim(xlWB.Name) = Trim(str_filename) Then
xlWB.Activate
If xlWB Is Nothing Then
MsgBox "Workbook still not active in List_Open_Workbooks"
b_abort = True
Exit Sub
Else
' Sheets("RTM").Activate
Workbooks(xlWB.Name).Worksheets("RTM").range("First_Cell_For_Data").Select
range("First_Cell_For_Data").Select
If Trim(ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(ActiveCell.Value) = ""
ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
End If
End If
Next xlWB
Set xlApp = Nothing
Set xlWB = Nothing
End Sub
Function to extract filename from path/filename
Function getName(pf)
getName = Split(Mid(pf, InStrRev(pf, "\") + 1), ".")(0) & ".xlsx"
End Function
I am hoping I found the source of my problem and solved it.
I believe that referring to an open workbook in sub using Dim wb_open As Object & Set wb_open = ActiveWorkbook in the Check_Excel_RTM_Template sub is causing my inconsistent problems....perhaps this is an anomoly (bug) in the VBA implementation in Word.
In the revised code I posted below I am passing the o_Excel object from the calling routine and using oExcel.Activesheet.xxx to reference ranges and values.
Now I next problem is that I am having errors on the form control button code which also uses the Dim wb_open As Object & Set wb_open = ActiveWorkbook approach to referring to the open workbook. But I'll post that as a new question.
Thanks to all who commented and provided suggestions.
Sub Check_Excel_RTM_Template(oExcel As Object)
Dim i_starting_row_for_data As Integer
Dim str_filename As String
i_rows_of_data = 0
On Error GoTo Err1:
oExcel.ActiveSheet.range("First_Cell_For_Data").Select
If Trim(oExcel.ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(oExcel.ActiveCell.Value) = ""
oExcel.ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
Exit Sub
Err1:
Documents(str_doc_index).Activate
MsgBox getName(str_Excel_Filename) & " is not a RTM template file."
b_abort = True
End Sub
SOLVED! See the code below for the solution!
I have an Excel file containing multiple shape objects next to a series of text. I wrote a script to identify the location of each shape, identify how many cells to the right and down the text extends to, sets that as a range and then imports that into a chart object so I can save it as a .jpg.
The trouble is that between the creation of the chart and the pasting of the string there exists a Race Condition. If I step through the script it works fine, but as soon as I run it I get nothing but blank images.
I've tried Application.ScreenUpdating = True; Application.PrintCommunication = True; and DoEvents
I've also tried Application.Wait, but even having it wait ten seconds doesn't do the trick, when stepping through the code the chart is loaded in less than 2 seconds.
Recently I tried the kernel32 sleep method as well, and that doesn't seem to work either. Again, the amount of time I let the system sleep far exceeded my stepping. I also added all of the above methods between each line within the With statement (obviously not as a solution, but as a test) and that didn't work either..
At this point I'm completely at a loss.
If I place a stop at .Chart.Paste and then run the script (F5), and just keep hitting Run then the script works wonderfully. I just don't want users to have to sit there and hit run 600 times.
There are obvious redundancies written in between the creation of the chart and pasting of the text. This is all in the attempt at getting the code to work properly when run, and once a solution is found most of that code will be removed.
Option Explicit
Public Function ChartCheck() As String
ReCheckChart:
DoEvents
If ActiveWorkbook.ActiveSheet.ChartObjects.Count > 0 Then
GoTo ContinuePaste:
Else
GoTo ReCheckChart:
ContinuePaste:
End If
End Function
Public Function GetFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder to Save the Images In"
.AllowMultiSelect = False
If .Show -1 Then GoTo NextCode:
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
Private Sub DNImageExtraction_Click()
Dim fileName As String
Dim targetWorkbook As Excel.Workbook
Dim targetWorksheet As Excel.Worksheet
Dim saveLocation As Variant
Dim saveName As String
Dim targetShape As Shape
Dim workingRange As Excel.Range
Dim bottomRow As Long
Dim workingRangeWidth As Double
Dim workingRangeHeight As Double
Dim tempChart As ChartObject
Application.ScreenUpdating = False
Application.DisplayAlerts = False
DNImageExtraction.AutoSize = False 'This is necessary to prevent the system I use from altering the font on the button
DNImageExtraction.AutoSize = True
DNImageExtraction.Height = 38.4
DNImageExtraction.Left = 19.2
DNImageExtraction.Width = 133.8
fileName = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", , "Please select Excel file...")
Set targetWorkbook = Workbooks.Open(fileName)
Set targetWorksheet = targetWorkbook.ActiveSheet
saveLocation = GetFolder
For Each targetShape In targetWorksheet.Shapes
Set workingRange = targetWorksheet.Cells(targetShape.TopLeftCell.Row, targetShape.TopLeftCell.Column).Offset(1, 0)
saveName = workingRange.Text
If workingRange.Offset(0, 1).Value "" Then
If workingRange.Offset(1, 1).Value = "" Then
Set workingRange = Nothing
Set workingRange = targetWorksheet.Cells(targetShape.TopLeftCell.Row, targetShape.TopLeftCell.Column).Resize(, 2)
Else
bottomRow = workingRange.Offset(0, 1).End(xlDown).Row
Set workingRange = targetWorksheet.Cells(targetShape.TopLeftCell.Row, targetShape.TopLeftCell.Column).Resize((bottomRow + 2 - workingRange.Row), 2)
End If
workingRangeWidth = workingRange.Width
workingRangeHeight = workingRange.Height
End If
workingRange.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
Set tempChart = targetWorksheet.ChartObjects.Add(0, 0, workingRangeWidth, workingRangeHeight)
Application.ScreenUpdating = True
Application.PrintCommunication = True
DoEvents
Call ChartCheck
tempChart.Chart.Paste
Application.ScreenUpdating = False
tempChart.Chart.Export fileName:=saveLocation & "\DN " & saveName & ".jpg", Filtername:="JPG"
tempChart.Delete
Set tempChart = Nothing
Next
Application.Workbooks(targetWorkbook.Name).Close savechanges:=False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Any assistance in either a solution to the Race Condition, or re organizing the script to avoid the Race Condition altogether would be greatly appreciated.
(Code above was updated per suggestions made by Macro Man, and then re-modified once again to add in all previous suggestions on how to fix Race Condition issues after the changes were not effective.)
Consider using Application.OnTime which is good feature. It allows the scheduling of some code to be run at a certain time, most often one adds a few seconds to the current time.
Excel VBA is single-threaded and so there is no real synchronization but there is a message pump to keep order. The great thing about Application.OnTime is that it will not run despite being scheduled until the current graph of code has completed.
Because Application.OnTime uses the message pump as that is a FIFO structure it is possible to interleave the execution of code.
I think this might help here.
You can schedule a "hasItFinished" procedure which checks the existence of the shape/chart objects and if not re-schedules itself.
P.S. Can be a little tricky to debug, refactor as much code as possible outside of the procedure that you will schedule and unit test them separately. Please don't expect the lovely Edit,Debug and Continue flow that you normally get with VBA if you go down this path.
Try getting rid of the error handlers and labels, and working with objects directly instead of searching through workbook/worksheet collections. Also using meaningful variable names and proper indentation will help follow the code easily should you have any issues.
If your code works when stepping through, that usually suggests there is some issue with the use of ActiveWorkbook when workbooks are being opened/closed. Working with workbooks as objects allows us to overcome that problem because no matter if the workbook is active or not, we are always using the same instance of that workbook.
Private Sub DNImageExtraction_Click()
Dim fileName As String
Dim targetWorkbook As Excel.Workbook
Dim targetWorksheet As Excel.Worksheet
Dim saveLocation As Variant
Dim saveName As String
Dim targetShape As Shape
Dim workingRange As Excel.Range
Dim bottomRow As Long
Dim workingRangeWidth As Double
Dim workingRangeHeight As Double
Dim tempChart As ChartObject
Application.ScreenUpdating = False
Application.DisplayAlerts = False
fileName = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", , "Please select Excel file...")
Set targetWorkbook = Workbooks.Open(fileName)
Set targetWorksheet = targetWorkbook.ActiveSheet
saveLocation = GetFolder
For Each targetShape In targetWorksheet.Shapes
Set workingRange = targetWorksheet.Cells(targetShape.TopLeftCell.Row, targetShape.TopLeftCell.Column).Offset(1, 0)
saveName = workingRange.Text
If workingRange.Offset(0, 1).value <> "" Then
If workingRange.Offset(1, 1).value = "" Then
Set workingRange = Nothing
Set workingRange = targetWorksheet.Cells(targetShape.TopLeftCell.Row, targetShape.TopLeftCell.Column).Resize(, 2)
Else
bottomRow = workingRange.Offset(0, 1).End(xlDown).Row
Set workingRange = targetWorksheet.Cells(targetShape.TopLeftCell.Row, targetShape.TopLeftCell.Column).Resize((bottomRow + 2 - workingRange.Row), 2)
End If
workingRangeWidth = workingRange.Width
workingRangeHeight = workingRange.Height
End If
workingRange.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
Set tempChart = targetWorksheet.ChartObjects.Add(0, 0, workingRangeWidth, workingRangeHeight)
With tempChart
.Chart.Paste
.Chart.Export FileName:=saveLocation & "\DN " & saveName & ".jpg", Filtername:="JPG"
.Delete
End With
Set tmpChart = Nothing
DoEvents
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub