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
