Excel VBA Create A Picture From Cells

Creating Image From Selected Cells And Saving

        An image is created  from the selected cell or cells. The generated images are saved to the in the same  location with workbook.

Image names are checked and each recorded image is saved with a different name.
For example : myimage1.jpg, myimage2.jpg


Codes that provide us to build the image:
Sub CopyRangeToJpg()
    Dim rng As Excel.Range
    Dim cht As Excel.ChartObject
    Dim alan As String
    Dim i As Long
   Dim strPath As String
   strPath = ThisWorkbook.Path & "\"
       Application.ScreenUpdating = False
    alan = Selection.Address
    For i = 1 To 1
        Set rng = Sheets(i).Range(alan)
        rng.CopyPicture xlScreen, xlPicture
        Set cht = Sheets(i).ChartObjects.Add(0, 0, rng.Width + 10, rng.Height + 10)
        cht.Chart.Paste
        cht.Chart.Export DosyaKontrolu(strPath, "myimage", ".jpg", i)
        cht.Delete
ExitProc:
        Application.ScreenUpdating = True
        Set cht = Nothing
        Set rng = Nothing
    Next
End Sub


The following function is used to check the image name and save the image with a different name:


Private Function DosyaKontrolu(DosyaYolu As String, DosyaOnEk As String, DosyaUzanti As String, Sayi As Long) As String
    Dim fso As Object
    Dim Kontrol As Boolean
    Dim TamDosyaYolu As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    With fso
        Do
          TamDosyaYolu = DosyaYolu & DosyaOnEk & Sayi & DosyaUzanti
           Kontrol = fso.FileExists(TamDosyaYolu)
           Sayi = Sayi + 1
        Loop Until Not Kontrol
        DosyaKontrolu = TamDosyaYolu
    End With
    Set fso = Nothing
End Function




myimage1.jpg


2 comments:

  1. please show the vba code how to do this

    ReplyDelete
  2. Dear sir,
    will you give me the vba code for this "create a image from cell".......Please I need it much.....please send me to bhaiswarpravin@gmail.com

    ReplyDelete