Save image of range in next column excel vba - vba

Question

On the activesheet in column A, I have text of which I want to save image and place it in column B.
I can't figure out how to remove the lines and axis etc and just get a image of the range. Currently it's showing lines and axis in the image.
Sub Generate_Images()
Dim wK As Worksheet
Dim oCht As Chart
Dim i As Long, fI As Long
Dim fName As String
Application.DisplayAlerts = False
Set wK = ActiveSheet
fI = wK.Range("A" & wK.Rows.Count).End(xlUp).Row
wK.Columns("B:B").ColumnWidth = wK.Columns("A:A").ColumnWidth
For i = 1 To fI
wK.Range("A" & i).CopyPicture xlScreen, xlBitmap
Set oCht = ThisWorkbook.Charts.Add
With oCht
.ChartArea.Border.LineStyle = xlNone
.Paste
fName = ThisWorkbook.Path & "\" & Format(Now(), "DDMMYYHHMMSS") & ".png"
.Export Filename:=fName, Filtername:="PNG"
.Delete
End With
With wK.Pictures.Insert(fName)
With .ShapeRange
.LockAspectRatio = msoTrue
.Width = wK.Range("A" & i).Width
.Height = wK.Range("A" & i).Height
End With
.Left = wK.Range("B" & i).Left
.Top = wK.Range("B" & i).Top
.Placement = 1
.PrintObject = True
End With
Application.Wait Now + TimeValue("00:00:01")
Next i
Application.DisplayAlerts = True
End Sub

Answer 1

Why export and then re-import the image when you can just paste it straight into the sheet?
Sub Generate_Images()
Dim wK As Worksheet
Dim oCht As Chart
Dim i As Long, fI As Long
Dim fName As String
Application.DisplayAlerts = False
Set wK = ActiveSheet
fI = wK.Range("A" & wK.Rows.Count).End(xlUp).Row
wK.Columns("B:B").ColumnWidth = wK.Columns("A:A").ColumnWidth
For i = 1 To fI
wK.Range("A" & i).CopyPicture xlScreen, xlBitmap
wK.Paste
With wK.Pictures(wK.Pictures.Count)
.Left = wK.Range("B" & i).Left
.Top = wK.Range("B" & i).Top
.Placement = 1
.PrintObject = True
End With
Application.Wait Now + TimeValue("00:00:01")
Next i
Application.DisplayAlerts = True
End Sub

Answer 2

If you save image to picture file, then try this.
Instead Chart, use chartobject. It is possible to change chart's size.
And if your active cell is not empty, Excell automatically create chart base on data.
So, you must delete chart's seriescollecton.
Sub Generate_Images()
Dim wK As Worksheet
Dim oCht As Chart
Dim i As Long, fI As Long, j As Long
Dim fName As String
Dim obj As ChartObject
Dim n As Long
Dim w As Single, h As Single
Application.DisplayAlerts = False
Set wK = ActiveSheet
wK.Pictures.Delete
fI = wK.Range("A" & wK.Rows.Count).End(xlUp).Row
wK.Columns("B:B").ColumnWidth = wK.Columns("A:A").ColumnWidth
For i = 1 To fI
w = wK.Range("A" & i).Width
h = wK.Range("A" & i).Height
wK.Range("A" & i).CopyPicture xlScreen, xlBitmap
Set obj = wK.ChartObjects.Add(Range("c1").Left, 0, w, h)
Set oCht = obj.Chart
With oCht
n = .SeriesCollection.Count
For j = n To 1 Step -1
.SeriesCollection(j).Delete
Next j
.ChartArea.Border.LineStyle = xlNone
.Paste
fName = ThisWorkbook.Path & "\" & Format(Now(), "DDMMYYHHMMSS") & ".png"
.Export Filename:=fName, Filtername:="PNG"
obj.Delete
End With
With wK.Pictures.Insert(fName)
.Left = wK.Range("B" & i).Left
.Top = wK.Range("B" & i).Top
.Placement = 1
.PrintObject = True
End With
Application.Wait Now + TimeValue("00:00:01")
Next i
Application.DisplayAlerts = True
End Sub