WinBatch Tech Support Home

Database Search

If you can't find the information using the categories below, post a question over in our WinBatch Tech Support Forum.

TechHome

WinBatch
OLE COM ADO CDO ADSI LDAP
OLE with Excel
plus
Samples from Users

Can't find the information you are looking for here? Then leave a message over on our WinBatch Tech Support Forum.

Exporting Excel Pictures

Basically, the picture of the car is placed into the empty chart, the chart is re-sized, then exported as a gif, then the chart is emptied (presumably for the next picture). The gif name is the same as the picture object, i.e. Picture1.gif - and from there you can use an ADO stream to place the gif into an Access Table. I included other shapes in the sample xls to illustrate how Typename() comes in handy :)

I would probably set up a worksheet with nothing in it but a blank chart object, create an object handle to it, then open and process pictures from other workbooks using a UDF to place them in the chart object and export... 


;Winbatch 2005C - working with Excel Shapes
;Stan Littlefield, April 6, 2005
;//////////////////////////////////////////////////////////////////////
gosub udfs
IntControl(73,1,0,0,0)  
path = dirscript()
cXLS = StrCat(path,"xled1.xls")
If ! FileExist(cXLS) Then Exit
cWsc = StrCat(dirscript(),"tn.wsc")
If ! FileExist(cWsc)
   CrTn(cWsc)
Endif
oObj = GetObject(StrCat("script:",cWsc)) 
                 
oXL=0
oXL = CreateObject("Excel.Application")
oXL.Visible          = @TRUE  
oXL.ScreenUpdating   = @TRUE   
oXL.UserControl      = @TRUE
oXL.DisplayAlerts    = @FALSE
oXL.WorkBooks.Open(cXLS)
oWS = oXL.ActiveWorkbook.Worksheets(1)
oWS.Activate()
n = oWS.Shapes.Count
Message(oWS.Name,StrCat("has ",n," shapes"))
If n==0 Then goto end
isPict = 0
For i = 1 To n
   cShape = oObj.GetTn( oWS.Shapes(i).OLEFormat.Object )
   ShName = oWS.Shapes(i).name
   Message(StrCat("shape ",i," name ",ShName),cShape)
   ;now, just to test you can manipulate the shape in question
   If StrUpper(cShape)=="PICTURE"
      cGIF = StrCat(path,StrReplace(ShName," ",""),".gif")
      If FileExist(cGIF) Then FileDelet(cGIF)
      Hi = oWS.Shapes(i).Height   
      Wi = oWS.Shapes(i).Width    
      oWS.Shapes(i).Copy()
      message(cShape,"Copied To Clipboard")
      isPict=1  
   Endif
   If StrUpper(cShape)=="CHARTOBJECT" && isPict
      oChart = oWS.ChartObjects("%ShName%")
      oChart.Activate()
      message("","Paste Picture from Clipboard into Chart Object")
      oC = oXL.ActiveChart
      oWS.ChartObjects(1).Height = Hi
      oWS.ChartObjects(1).Width  = Wi
      oC.Paste()
      Message("Picture Resized in Chart",StrCat("Ready to be Exported...",@CRLF,"to a Gif File with",@CRLF,".ActiveChart.Export() function") )
      If FileExist(cGIF) Then FileDelete(cGIF)
      oC.Export( :: FileName="%cGIF%", FilterName="GIF" )
      If FileExist(cGIF) Then Message("Export Was Successful",cGIF)
      oC.Pictures(1).Delete()
      Message("Picture Removed From Chart","In Case Looping multiple pictures")
      oChart=0
      oC=0
   Endif
      
Next

:end
oObj=0
oWS=0
oXL.Quit()
oXL = 0

Exit


:WBERRORHANDLER
IntControl(73,1,0,0,0)
ErrorProcessing(0,1,0)
oXL=0
Exit

:udfs

#DefineFunction CrTn(cWsc)
If FileExist(cWsc) Then Return(0)
var = StrCat('',@CRLF,"",@CRLF,'',@CRLF)
var = StrCat(var,'',@CRLF,'',@CRLF)
var = StrCat(var,'',@CRLF,'	',@CRLF,'		',@CRLF,'	',@CRLF)
var = StrCat(var,'  ',@CRLF,'		',@CRLF,' 	',@CRLF,'',@CRLF)
var = StrCat(var,'',@CRLF)
var = StrCat(var,'',@CRLF,'',@CRLF)
FilePut(cWsc,var)
#EndFunction

#DefineSubroutine ErrorProcessing(deleteIni,showerr,logfile)  
WbError = LastError()
WbTextcode = WbError
If WbError==1668||WbError==2669||WbError==3670
   ; 1668 ; "Minor user-defined error"
   ; 2669 ; "Moderate user-defined error"
   ; 3670 ; "Severe user-defined error"
   WbError = ItemExtract(1,IntControl(34,-1,0,0,0),":")
   WbTextcode = -1
EndIf
WbErrorString = IntControl(34,WbTextcode,0,0,0)
WbErrorDateTime = TimeYmdHms()
WbErrorFile = StrCat(DirWindows(0),"WWWBATCH.INI")
If deleteIni
   FileDelete(WbErrorFile)
   IniWritePvt(WbErrorDateTime,"CurrentScript",WbErrorHandlerFile      ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ErrorValue"   ,WbError                 ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ErrorString"  ,WbErrorString           ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ScriptLine"   ,WbErrorHandlerLine      ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ScriptOffset" ,WbErrorHandlerOffset    ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"VarAssignment",WbErrorHandlerAssignment,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"VarInSegment" ,WbErrorInSegment,WbErrorFile)
   IniWritePvt("","","",WbErrorFile)
Endif  
WbErrorMsgText = StrCat(WbErrorDateTime,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Current Script: ",WbErrorHandlerFile,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error# [",WbError,"]",@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error Text: ",wberrortextstring,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"[Extended Information] ",wberroradditionalinfo,@CRLF,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"On Line:",@CRLF,WbErrorHandlerLine,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Offset: ",WbErrorHandlerOffset,@CRLF)
If (WbErrorHandlerAssignment>"") Then %WbErrorHandlerAssignment% = "UNKNOWN"
WbErrorMsgText = StrCat(WbErrorMsgText,"Assignment/Variable: ",WbErrorHandlerAssignment,@CRLF)
If (WbErrorInSegment>"") Then WbErrorMsgText = StrCat(WbErrorMsgText,"In UDF/UDS: ",WbErrorInSegment,@CRLF)
If logfile
   cSep = StrCat(StrFill("=",50),@CRLF)
   cLogFile = StrCat(dirscript(),"log.err")
   If ! FileExist(cLogFile) Then FilePut(cLogFile,StrCat("Error Log",@CRLF,cSep))
   FilePut(cLogFile,StrCat(FileGet(cLogFile),WbErrorMsgText,cSep))
Endif
If showerr Then Message("wbErrorHandler",WbErrorMsgText)
Return(1)
#EndSubroutine

Return
;/////////////////////////////////////////////////////////////////////////////////////

Article ID:   W17155

File Created: 2007:07:03:14:28:30
Last Updated: 2007:07:03:14:28:30