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.
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