It occurred to me that when it works but nothing gets saved in the folder where the file is, that it's likely saving the file elsewhere. Maybe trial...
Code:
Msgbox ThisWorkbook.Path & "\" & FileNm & ".jpg"
.Chart.Export ThisWorkbook.Path & "\" & FileNm & ".jpg", "JPG"
or perhaps your file name is no good. You may need to add this...
Code:
Public Function ValidFilePath(Arg As String) As String
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Pattern = "[\\/:\*\?""<>\|]"
.Global = True
ValidFilePath = .Replace(Arg, "_")
End With
Set RegEx = Nothing
End Function
So you would then change this line of code...
Code:
.Chart.Export ThisWorkbook.Path & "\" & ValidFilePath(FileNm) & ".jpg", "JPG"
@jolivanes no offense intended. I have not tested with 50 pics and timed it and I don't plan on doing so as I'm not that invested in this project. It just seems a lot more efficient to not be repetitively creating and deleting charts when you really only need just one. Dave
It creates a chart size image that is unfortunately skewed in proportions
I get this error
Run-time error '75':
Path/File access error
in this line
.Chart.Export ThisWorkbook.Path & "\" & ValidFilePath(FileNm) & ".jpg", "JPG"
Sub test()
'pics in Sheet2 "A"; file name in sheet2 "B"
Dim MyChart As Chart
Dim sh As Shape
'add temp chart
Charts.Add.Location Where:=xlLocationAsObject, Name:="Sheet2"
Sheets("Sheet2").ChartObjects(Sheets("Sheet2").ChartObjects.Count).Name = "MYChart"
With Sheets("Sheet2")
For Each sh In .Shapes
If sh.Type = msoPicture Then
'make jpg files
Call CreateJPG(sh.Name, CStr(Range(sh.TopLeftCell.Address).Offset(, 1))) '<------Removed period before Range
End If
Next sh
End With
'remove temp chart
Sheets("Sheet2").ChartObjects("MYChart").Delete
End Sub
Sub CreateJPG(PicName As String, FileNm As String)
'make image files
'picname is XL picture name; FileNm is name of file
Dim xRgPic As Shape
Sheets("Sheet2").Activate
Set xRgPic = Sheets("Sheet2").Shapes(PicName)
xRgPic.CopyPicture
With Sheets("Sheet2").ChartObjects("MYChart")
.Activate
.Chart.Paste
.Chart.Export ThisWorkbook.Path & "\" & ValidFilePath(FileNm) & ".jpg", "JPG"
End With
End Sub
Public Function ValidFilePath(Arg As String) As String
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Pattern = "[\\/:\*\?""<>\|]"
.Global = True
ValidFilePath = .Replace(Arg, "_")
End With
Set RegEx = Nothing
End Function
