Save calendar month as jpg

[gailb]

I have an excel file with a worksheet that shows birthday's by month. I would like to copy D5:D14 and save as a jpg titled January, then G5:G14 and save as a jpg titled February and etc. until all 12 months are saved as a jpg. All of the months are the same number of rows.

Please see attached example.

[HansV]

This turned out to be trickier than I thought - Excel get confused if you try to export images in rapid succession.
See the attached version, now a macro-enabled workbook.

Birthdays.xlsm

[gailb]

Thanks Hans this will work great. So the DoEvents are required to slow down the macro to give Excel a breather, but it appears you had to double them up for even more spacing?

[HansV]

Yes. Before I added DoEvents, the code threw an error.
When I added single DoEvents, the code ran without error but produced empty images.
Apparently, two DoEvents are sufficient to let Excel catch up.

[ChrisGreaves]

Apparently, two DoEvents are sufficient to let Excel catch up.

Interesting!
I am tempted to replace all my instances of "DoEvents" (in all my code) with two instances, just to be safe.
Cheers
Chris

[HansV]

I'd only do that if you experience problems.
In this example, with only 12 export actions (one for each month), the overhead is negligible.
But if you're running a loop that gets executed thousands of times or more, DoEvents will have a serious impact on performance.

[jolivanes]

Hoi Hans.
Tried your workbook from your post (2nd post) but it errors at the "Shapes.AddChart2" line on Excel 2007.
Apparently that is only incorporated from 2013 and up.
I cobbled this together and it seems to work without errors.
However, there must be some things I don't see that might be problematic in the future, so called "haken en ogen".
Anything that stands out?

Code: Select all

Sub Export_Months()
Dim i As Long, j As Long, sh As Worksheet
Dim mo_rng As Range
Dim tempChartObj As ChartObject
Dim savePath As String
Set sh = Worksheets("Birthday")
    For i = 5 To 38 Step 11    'Rows
        For j = 4 To 10 Step 3    'Column
            Set mo_rng = Range(sh.Cells(i, j).Resize(10).Address)
            Set tempChartObj = ActiveSheet.ChartObjects.Add(1000, 100, mo_rng.Width, mo_rng.Height)   '<--- Empty part of sheet
            tempChartObj.Name = "TempChart01"
            savePath = ThisWorkbook.Path & "\" & Cells(i, j).Value & ".png"
                mo_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
                    tempChartObj.Chart.ChartArea.Select
                        tempChartObj.Chart.Paste
                    ActiveSheet.Shapes("TempChart01").Line.Visible = msoFalse
                tempChartObj.Chart.Export savePath
            tempChartObj.Delete
        Next j
    Next i
End Sub

[HansV]

The code is fine, but to be on the safe side I'd make all cell and range object refer explicitly to the sheet sh, so that the code will work from another sheet if necessary.

Code: Select all

Sub Export_Months()
    Dim i As Long, j As Long, sh As Worksheet
    Dim mo_rng As Range
    Dim tempChartObj As ChartObject
    Dim tempChart As Chart
    Dim savePath As String
    Set sh = Worksheets("Birthday")
    For i = 5 To 38 Step 11    'Rows
        For j = 4 To 10 Step 3    'Column
            Set mo_rng = sh.Cells(i, j).Resize(10)
            Set tempChartObj = sh.ChartObjects.Add(1000, 100, mo_rng.Width, mo_rng.Height)   '<--- Empty part of sheet
            Set tempChart = tempChartObj.Chart
            tempChartObj.Name = "TempChart01"
            savePath = ThisWorkbook.Path & "\" & sh.Cells(i, j).Value & ".png"
            mo_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
            tempChart.Paste
            sh.Shapes("TempChart01").Line.Visible = msoFalse
            tempChart.Export Filename:=savePath, FilterName:="PNG"
            tempChartObj.Delete
        Next j
    Next i
End Sub

[jolivanes]

Thank you very much Hans.
BTW Je bent nog laat op!!!

[HansV]

Ik ga vrijwel nooit voor middernacht naar bed...

[jolivanes]

Re: "Ik ga vrijwel nooit voor middernacht naar bed..."

Welcome to the club Hans. But I am retired and I don't know if you are.
My days of having to be at places at a given time, unless my personal boss a.k.a. the wife says so, are over!

[HansV]

I'm retired too, but before that I went to bed even later...