Saving Clipboard contents as Image

Scenario 1:
Earlier I had a challenging task to automate SVG charts. There are two issues. Major issue is, Silktest does not identify SVG Chart as any object (custom/HtmlImage). Second one is taking Bitmap image for the chart. SVG chart gives the flexibility by 'Copy SVG' feature. Using this we can copy the chart image. It can be saved as text or Image file.

Scenario 2:
Last month, I have posted VBA - Extract Pictures from Excel . It works fine, if this VBA code is executed as Excel Macro. But the same code does not extract the image with the right quality, after running as VB Script. I got the problem, while saving/pasting the clipboard copy. I was forced to find a way to implement a method, to save clipboard image as a image file.

Solution:
IrfanView is a windows graphic viewer and it is a freeware utility. It can be used command-line utility. It has a command-line option to save the clipboard image as image file. You can save the image in many different formats.

Syntax to Convert clipboard image as image file:
/clippaste - paste image from the clipboard.

Below I have given the way to implement in VBScript and Silktest.
Silktest code:

[ ] // To save the image
[ ] SYS_Execute ("D:\autostuff\i_view32.exe /silent /clippaste /convert=D:\my_scripts\testdata\zsvg1.bmp")

VB Script code:

'-------------------------------------------------------------------------
' Method    :   CreateImageFromClipBoard
' Author    :   Palani Selvam
' Purpose   :   It gets the clipboard image and convert as a image file.
' Parameters:   FileName - String, contains the BMP file name
'        iIndex - Integer, contains the Worksheet index
' Returns   :   String. The replaced file name it gives.
' Caller    :   - Nil
' Calls     :   - Nil
'-------------------------------------------------------------------------
Sub CreateImageFromClipBoard(sFileName)

    Dim wshShell,ShellReturnCode, sCmdExec
    
  Set WshShell = WScript.CreateObject("WScript.Shell")
  sCmdExec = "D:\autostuff\i_view32.exe /silent /clippaste /convert="& sFileName 

  ShellReturnCode = WshShell.Run(sCmdExec, 1, True)  
    
End Sub

Modified VB Script code for VBA - Extract Pictures from Excel
Note: Few function calls are from my vbscript library.

'--------------------------------------
' Method    :   ReadExcel
' Author    :   T. Palani Selvam
' Purpose   :   Read all the contents from Excel sheet and write into log file
' Parameters:   sExcelFile - String, contains the Excel file
'      :  iSheetIndex - Integer, Value for Sheet Index
' Returns   :   - Nil
' Caller    :   - Nil
' Calls     :   - Nil
'--------------------------------------
Sub ReadExcel(sExcelFile, iSheetIndex)
 Dim sExcelPath 'As Variant  'Excel file
 '********** Excel object declaration **********'
  ' Excel Application object
 Dim objExcel 'As Excel.Application
 Dim objXLWorkbooks 'As Excel.Workbooks
 Dim objXLWorkbook 'As Excel.Workbook

 Dim WorkSheetCount 'As Variant  'Work sheets count in a excel
 Dim CurrentWorkSheet 'As Excel.Worksheet    ' Current worksheet
 Dim objCells 'As Excel.Range
 Dim objCurrentCell 'As Variant
 Dim objFont 'As Variant

 ' Result contents
 Dim sCellText 'As Variant
 Dim sFontName 'As Variant
 Dim sFontStyle 'As Variant
 Dim iFontSize 'As Variant
 Dim iCellTextColorIndex 'As Variant
 Dim iCellInteriorColorIndex 'As Variant
 Dim sResult 'As Variant
 Dim sChartFile 'As String


 ' Row and Col integer variables
 Dim iUsedRowsCount 'As Integer
 Dim iUsedColsCount 'As Integer
 Dim iTop, iLeft 'As Integer
 Dim iRow 'As Integer     'Row item
 Dim iCol 'As Integer     'Col item
 Dim iCurRow 'As Integer
 Dim iCurCol 'As Integer


 If (sExcelFile = "") Then
   sExcelPath = "D:\my_scripts\Basic Wks.xls"
 Else
   sExcelPath = sExcelFile
 End If

 If (iSheetIndex = "") Then
  iSheetIndex = 2
 End If


 Call FileDeleteAndCreate (gsLogFile)

 'XL file check
 If (FileExists(sExcelPath) <> 0) Then
  Call LogWrite (gsLogFile, "The Excel file " & Chr(34) & sExcelPath & Chr(34) & " does not exit!")
  Exit sub
 End If

 Set objExcel = CreateObject("Excel.Application")
 objExcel.Workbooks.Open sExcelPath, False, True

 On Error Resume Next

 Set objXLWorkbook = objExcel.ActiveWorkbook
 'objXLWorkbook.RunAutoMacros
 
 WorkSheetCount = objXLWorkbook.Worksheets.Count

 Set CurrentWorkSheet = objExcel.ActiveWorkbook.Worksheets(iSheetIndex) 'iSheetIndex worksheet

 iUsedRowsCount = CurrentWorkSheet.UsedRange.Rows.Count
 iUsedColsCount = CurrentWorkSheet.UsedRange.Columns.Count
 iTop = CurrentWorkSheet.UsedRange.Row
 iLeft = CurrentWorkSheet.UsedRange.Column

 ' Cells object
 CurrentWorkSheet.Cells.Activate


 For iRow = iTop To iUsedRowsCount-1   '(iUsedRowsCount - 1)
   'Read All rows
   For iCol = iLeft To iUsedColsCount  '(iUsedColsCount - 1)

     sResult = ""
     Set objCurrentCell = CurrentWorkSheet.Cells(iRow, iCol)
     sCellText = objCurrentCell.Text


     If ((sCellText = Empty)) Then


       sResult = "Reading Cell {" & CStr(iRow) & ", " & CStr(iCol) & "}^" &"  "& "^" & "  " & "^" & "  " & "^" & "  " & "^" & "  " & "^" & "  "

       Call LogWrite (gsLogFile, sResult)

     Else
       Set objFont = objCurrentCell.Font
       sFontName = objFont.Name
       sFontStyle = objFont.FontStyle
       iFontSize = objFont.Size
       iCellTextColorIndex = objFont.Color
       iCellInteriorColorIndex = objCurrentCell.Interior.ColorIndex



       If (sFontName = Empty) Then
         sFontName = "empty"
       End If
       If (sFontStyle = Empty) Then
         sFontStyle = "empty"
       End If
       If (iFontSize = Empty) Then
         iFontSize = "-99999999"
       End If
       If (iCellTextColorIndex = Empty) Then
         iCellTextColorIndex = "99999999"
       End If
       If (iCellInteriorColorIndex = Empty) Then
         iCellInteriorColorIndex = "99999999"
       End If


       sResult = "Reading Cell {" & CStr(iRow) & ", " & CStr(iCol) & "}^" & sCellText & "^" & CStr(iCellInteriorColorIndex) & "^" & sFontName & "^" & CStr(sFontStyle) & "^" & CStr(iFontSize) & "^" & CStr(iCellTextColorIndex)

       Call LogWrite (gsLogFile, sResult)

     End If

     Set objCurrentCell = Nothing


   Next

 Next
 'Get the Chart now
 'sChartFile = Replace (sExcelFile,".xls",".png")
 sChartFile = Replace (sExcelFile,".xls",".bmp")
 
  '*****************************
  ' Place for Chart creation
    objExcel.ScreenUpdating = False
    
  Dim iIndex,iPictureHeight,iPictureWidth,iShapeCount
  Dim aShape, aChart, aShapeChart, aChart1
  Dim sPictureShape, sChartName, sCurrentSheet
 
 
 'Set aWorkSheet = ActiveWorkbook.ActiveSheet
 
 sCurrentSheet = CurrentWorkSheet.Name
  
 For iIndex = 1 To CurrentWorkSheet.Shapes.Count
 
  Set aShape = CurrentWorkSheet.Shapes(iIndex)
  sPictureShape = aShape.Name    
  'Picture 1 Name,  13
  
  If Left(aShape.Name, 7) = "Picture" Then
   aShape.CopyPicture
   Call CreateImageFromClipBoard (sChartFile)
     
   ''objExcel.ScreenUpdating = True
   Exit For

  End If
 Next
 
 if FileExists(sChartFile)=0 Then
  Call LogWrite (gsLogFile, "Chart Image: " & sChartFile)
 End If
 
 ' This will prevent Excel from prompting us to save the workbook.
 objExcel.ActiveWorkbook.Saved = True
 Set CurrentWorkSheet = Nothing

 'objExcel.Worksbooks.Close
 objExcel.Quit

 ''Set CurrentWorkSheet = Nothing
 Set objExcel = Nothing

 'MsgBox "Read Completed.", vbOKOnly, "Exec Over"
 Exit Sub

 ErrorHandler1:
 'MsgBox "Error # " & CStr(Err.Number) & " " & Err.Description
 'Err.Clear   ' Clear the error.
End Sub