2

I finally was able to export excel text as .jpg image file using Excel VBA. I was able to find articles/posts/blogs on how to export a picture/clipart as an image but could not find anything on text. Now that finally I was able to do it, the picture that gets exported is blurry. Please advice how can I get a good picture quality. Here is the exported picture. It looks good on excel but not as a picture. I tried changing the format as .png with not much of a difference. Fonts used Monotype Corsiva for heading and Times New Roman Italics for text. enter image description here My text is in the range A1:L21 and here is the code that I found somewhere on the Internet which was modified as per my needs

Option Explicit

Sub ExportMyTextAsPicture()

     Dim MyChart As String, MyPicture As String
     Dim PicWidth As Long, PicHeight As Long

     Application.ScreenUpdating = False
     On Error GoTo Finish

    Range("A1:L21").Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    Range("A23").Select
    ActiveSheet.Paste

     MyPicture = Selection.Name
     With Selection
           PicHeight = .ShapeRange.Height
           PicWidth = .ShapeRange.Width
     End With

     Charts.Add
     ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
     Selection.Border.LineStyle = 0
     MyChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)

     With ActiveSheet
           With .Shapes(MyChart)
                 .Width = PicWidth
                 .Height = PicHeight
           End With

           .Shapes(MyPicture).Copy

           With ActiveChart
                 .ChartArea.Select
                 .Paste
           End With

           .ChartObjects(1).Chart.Export Filename:="mymymy.jpg", FilterName:="jpg"
           .Shapes(MyChart).Cut
     End With

     ActiveSheet.DrawingObjects.Select
     Selection.Cut

     Application.ScreenUpdating = True
     Exit Sub

Finish:
     MsgBox "You must select a picture"
End Sub

Here is the original code (incase anyone needs it) that I searched for... to export picture/clipart. (The image needs to be selected before running the macro)

Option Explicit

Sub ExportMyPicture()

     Dim MyChart As String, MyPicture As String
     Dim PicWidth As Long, PicHeight As Long

     Application.ScreenUpdating = False
     On Error GoTo Finish


     MyPicture = Selection.Name
     With Selection
           PicHeight = .ShapeRange.Height
           PicWidth = .ShapeRange.Width
     End With

     Charts.Add
     ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
     Selection.Border.LineStyle = 0
     MyChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)

     With ActiveSheet
           With .Shapes(MyChart)
                 .Width = PicWidth
                 .Height = PicHeight
           End With

           .Shapes(MyPicture).Copy

           With ActiveChart
                 .ChartArea.Select
                 .Paste
           End With

           .ChartObjects(1).Chart.Export Filename:="mymymy.jpg", FilterName:="jpg"
           .Shapes(MyChart).Cut
     End With

     Application.ScreenUpdating = True
     Exit Sub

Finish:
     MsgBox "You must select a picture"
End Sub
Mumbai CabinCrew
  • 341
  • 2
  • 4
  • 14

2 Answers2

1

I had a similar situation. I created the information in Excel that needed to be created into images. The image would always be saved as a compressed image, especially with the fonts. It would not save the fonts as anti-aliased. To go around that, I printed/saved it as a PDF file instead.

0

You can also save to PDF programmatically using VBA, as discussed in this thread and on this site.

Community
  • 1
  • 1
Scott Offen
  • 6,933
  • 3
  • 21
  • 24