export a range and save as .jpg

Can anybody help me?

I need a macro that will take a range of cells (A1:F20) and export them and SAVE AS a .jpg file.
The file should save to a designated directory (C:\Backups\) and the filename should be "counts" + the current date.

example: C:\Backups\counts 5-3-2010

Any ideas?

Made some tweaks to existing code, but haven't tested - you run the JPGSnapshot routine.

Option Explicit
' Harold Staff -- see http://www.mvps.org/dmcritchie/excel/xl2gif.htm
' XL2GIF_module -- GIF_Snapshot
' Adapted by R for JPG export
Dim container As Chart
Dim containerbook As Workbook
Dim Sourcebook As Workbook

Function SelectArea() As String
    Dim Internrange As Range
    On Error GoTo err_handler
    Set Internrange = Application.InputBox("Select " _
        & "range to be photographed:", "Picture Selection", _
        Selection.AddressLocal, Type:=8)
    SelectArea = Internrange.address
    Exit Function
err_handler:
    SelectArea = "A1"
End Function

Function sShortname(ByVal Original As String) As String
    Dim i As Integer
    sShortname = ""
    i = InStr(Trim$(Original), " ")
    If i = 0 Then
        sShortname = Original
    Else
        sShortname = left$(Original, i - 1)
    End If
End Function

Private Function CreateContainer(ByRef wbk As Workbook) As Chart
    Set container = wbk.Charts.Add
    With container
        .ChartType = xlColumnClustered
        .SetSourceData source:=wbk.Worksheets(1).Range("A1")
        .Location Where:=xlLocationAsObject, Name:=wbk.Sheets(2).Name
    End With
    Set CreateContainer = ActiveChart
    CreateContainer.ChartArea.ClearContents
End Function

Sub MakeAndSizeChart(ByRef cht As Chart, ih As Integer, iv As Integer)
    Dim Hincrease As Single
    Dim Vincrease As Single
    Hincrease = ih / cht.ChartArea.Height
    cht.Parent.ShapeRange.ScaleHeight Hincrease, _
       msoFalse, msoScaleFromTopLeft
    Vincrease = iv / cht.ChartArea.Width
    cht.Parent.ShapeRange.ScaleWidth Vincrease, _
       msoFalse, msoScaleFromTopLeft
End Sub

Public Sub JPG_Snapshot()
    Dim varReturn As Variant
    Dim MyAddress As String
    Dim SaveName As Variant
    Dim MySuggest As String
    Dim Hi As Integer
    Dim Wi As Integer
    Dim wks As Worksheet
    
    Set Sourcebook = ActiveWorkbook
    Set wks = ActiveSheet
    Set containerbook = Workbooks.Add(1)
    containerbook.Sheets(1).Name = "JPGcontainer"
    MySuggest = sShortname(wks.Name)
    Set container = CreateContainer(containerbook)
    MyAddress = SelectArea
    If MyAddress <> "A1" Then
        SaveName = "C:\Backups\counts " & Format(Date, "m-d-yyyy") & ".jpg"
        If SaveName <> False Then
            With wks.Range(MyAddress)
                .CopyPicture Appearance:=xlScreen, Format:=xlBitmap
                Hi = .Height + 4  'adjustment for gridlines
                Wi = .Width + 6   'adjustment for gridlines
            End With
            MakeAndSizeChart container, ih:=Hi, iv:=Wi
            With container
                .Paste
                .Export FileName:=LCase(SaveName), FilterName:="jpg"
                .Pictures(1).Delete
            End With
            Sourcebook.Activate
        End If
    End If

    On Error Resume Next
    Application.StatusBar = False
    containerbook.Saved = True
    containerbook.Close
End Sub

See this link
http://www.mrexcel.com/forum/showthread.php?t=233108

Hope it helps...

Perhaps you could give us a little more to go on?

I mean, what specifically is the issue with the code?

Try this version:

Option Explicit
' Harold Staff -- see http://www.mvps.org/dmcritchie/excel/xl2gif.htm
' XL2GIF_module -- GIF_Snapshot
' Adapted by R for JPG export
Dim container As Chart
Dim containerbook As Workbook
Dim Sourcebook As Workbook

Function SelectArea() As String
    Dim Internrange As Range
    On Error GoTo err_handler
    Set Internrange = Application.InputBox("Select " _
        & "range to be photographed:", "Picture Selection", _
        , Type:=8)
    SelectArea = Internrange.Address
    Exit Function
err_handler:
    SelectArea = "A1"
End Function

Function sShortname(ByVal Original As String) As String
    Dim i As Integer
    sShortname = ""
    i = InStr(Trim$(Original), " ")
    If i = 0 Then
        sShortname = Original
    Else
        sShortname = Left$(Original, i - 1)
    End If
End Function

Private Function CreateContainer(ByRef wbk As Workbook) As Chart
    Set container = wbk.Charts.Add
    With container
        .ChartType = xlColumnClustered
        .SetSourceData Source:=wbk.Worksheets(1).Range("A1")
        .Location Where:=xlLocationAsObject, Name:=wbk.Sheets(2).Name
    End With
    Set CreateContainer = ActiveChart
    CreateContainer.ChartArea.ClearContents
End Function

Sub MakeAndSizeChart(ByRef cht As Chart, ih As Integer, iv As Integer)
    Dim Hincrease As Single
    Dim Vincrease As Single
    Hincrease = ih / cht.ChartArea.Height
    cht.Parent.ShapeRange.ScaleHeight Hincrease, _
       msoFalse, msoScaleFromTopLeft
    Vincrease = iv / cht.ChartArea.Width
    cht.Parent.ShapeRange.ScaleWidth Vincrease, _
       msoFalse, msoScaleFromTopLeft
End Sub

Public Sub JPG_Snapshot()
    Dim varReturn As Variant
    Dim MyAddress As String
    Dim SaveName As Variant
    Dim MySuggest As String
    Dim Hi As Integer
    Dim Wi As Integer
    Dim wks As Worksheet
    
    Set Sourcebook = ActiveWorkbook
    Set wks = ActiveSheet
    Set containerbook = Workbooks.Add(1)
    containerbook.Sheets(1).Name = "JPGcontainer"
    MySuggest = sShortname(wks.Name)
    Set container = CreateContainer(containerbook)
    Sourcebook.Activate
    MyAddress = SelectArea
    If MyAddress <> "A1" Then
        SaveName = "C:\Users\Stephen\Documents\Marshall\PDD Macro Test " & Format(Date, "m-d-yyyy") & ".jpg"
        If SaveName <> False Then
            With wks.Range(MyAddress)
                .CopyPicture Appearance:=xlScreen, Format:=xlBitmap
                Hi = .Height + 4  'adjustment for gridlines
                Wi = .Width + 6   'adjustment for gridlines
            End With
            MakeAndSizeChart container, ih:=Hi, iv:=Wi
            With container
                .Paste
                .Export Filename:=LCase(SaveName), FilterName:="jpg"
                .Pictures(1).Delete
            End With
            Sourcebook.Activate
        End If
    End If

    On Error Resume Next
    Application.StatusBar = False
    containerbook.Saved = True
    containerbook.Close
End Sub

Change this line in the JPG_Snapshot routine:

 MyAddress = SelectArea

to:

 MyAddress = "A1:C5"

for example.