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.

Excel Power Point Example

; Winbatch - 2004 B Testing Hiding everyththing but Visible Range
;            Then paste into PowerPoint
;
; Steps  Check for Excel File, Open It, Hide all but the
;        Active Range, select it and copy to clipboard as picture
;
;        Create an instance of Powerpoint, add a new presentation
;        then add a slide, paste in and adjust the Excel Picture
;
; NOTE: This script uses CreateObject("Powerpoint.Application.10")
;       adjust to suit your version of Powerpoint
;
; Stan Littlefield, May 27, 2004 - please retain this header
;/////////////////////////////////////////////////////////////////////

IntControl(73,1,0,0,0)
cXLS = StrCat(dirget(),"xlHide.xls")
If ! FileExist(cXLS) Then Exit
cPPT = StrReplace(StrUpper(cXLS),"XLS","PPT")
If FileExist(cPPT) Then FileDelete(cPPT)

Display(1,"Please Wait","Opening %cXLS%")
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()
xlDown=-4121
xlToRight=-4161
xlPicture=-4147
xlScreen=1
; there are known issues with Excel's xlLastCell constant
; the following performs an internal 'update' and is more accurate
r = oWS.UsedRange.Rows.Count +1
c = oWS.UsedRange.Columns.Count +1

; extra rows get hidden
oWS.Cells(r,1).Select()
oWS.Range(oXL.Selection, oXL.Selection.End(xlDown)).Select()
oXL.Selection.EntireRow.Hidden = @TRUE
; and extra columns
oWS.Cells(1,c).Select()
oWS.Range(oXL.Selection, oXL.Selection.End(xlToRight)).Select()
oXL.Selection.EntireColumn.Hidden = @TRUE
oWS.UsedRange.Select()

Display(1,"Please Continue To Wait","Opening Powerpoint")
; now let powerpoint take over
ppViewSlide=1
ppLayoutBlank=12
ppViewSlide=1
msoAlignCenters = 1
msoAlignMiddles = 4
PPApp = CreateObject("Powerpoint.Application.10")
PPApp.Activate()
PPPres = PPApp.Presentations.Add(@TRUE)
PPApp.ActiveWindow.ViewType = ppViewSlide
PPSlide = PPPres.Slides.Add(1,ppLayoutBlank)

; copy image, quit Excel
oXL.Selection.CopyPicture(:: Appearance=xlScreen,Format=xlPicture )
oWS =0
oXL.Quit()
oXL=0

; place image in powerpoint
PPSlide.Shapes.Paste.Select()
PPApp.ActiveWindow.Selection.ShapeRange.Align(msoAlignCenters, @True)
PPApp.ActiveWindow.Selection.ShapeRange.Align(msoAlignMiddles, @True)

Display(1,"Powerpoint file saved as...",cPPT)
PPPres.SaveAs( cPPT )
TimeDelay(2)
PPPres.Close()
PSlide = 0
PPPres = 0

PPApp.Quit()
PPApp = 0

Exit

:WBERRORHANDLER        ;from Detlev
IntControl(73,1,0,0,0)
PPApp = 0
oWS =0
oXL=0
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 = StrCat(TimeYmdHms(),"|",StrFixLeft(GetTickCount()," ",10))

WbErrorFile = StrCat(DirWindows(0),"WWWBATCH.INI")
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("","","",WbErrorFile)

WbErrorMsgText = StrCat(WbErrorDateTime,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Current Script: ",WbErrorHandlerFile,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"LastError #:",WbError,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error Text: ",wberrortextstring,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"[Additional] ",wberroradditionalinfo,@CRLF,@CRLF)
; Line in script that caused Error.
WbErrorMsgText = StrCat(WbErrorMsgText,"WbErrorHandlerLine:",@CRLF,WbErrorHandlerLine,@CRLF)
; Offset into script of error line, in bytes.
WbErrorMsgText = StrCat(WbErrorMsgText,"WbErrorHandlerOffset: ",WbErrorHandlerOffset,@CRLF)
; Variable being assigned on error line, or "" if none.
WbErrorMsgText = StrCat(WbErrorMsgText,"WbErrorHandlerAssignment: ",WbErrorHandlerAssignment,@CRLF)
If (WbErrorHandlerAssignment>"") Then %WbErrorHandlerAssignment% = "UNKNOWN"
ClipPut(WbErrorMsgText)
WbErrorMsgText = StrCat(WbErrorMsgText,"[Error Copied To Clipboard]")
Message("wbErrorHandler",WbErrorMsgText)
Exit
;//////////////////////////////////////////////////////////////////////////////////

Article ID:   W16613

File Created: 2005:02:18:12:21:38
Last Updated: 2005:02:18:12:21:38