COMPILE SUBROUTINE EXPORT_EPIPRO_MET(Dummy) * EPI Metrology Data Report - goes straight to Excel * 10/28/2008 John C. Henry, J.C. Henry & Co., Inc. Initial coding DECLARE SUBROUTINE ErrMsg, Btree.Extract, Set_Status, SetInitDirOptions DECLARE FUNCTION Msg, Get_Status, obj_Calendar, Utility, SetInitDirOptions, Dialog_Box, obj_RDS_Test, obj_WO_Log, DECLARE FUNCTION Popup, obj_Test_Point_Map, Environment_Services $INSERT RDS_EQU $INSERT RDS_LAYER_EQUATES $INSERT RDS_TEST_EQUATES $INSERT COMPANY_EQU $INSERT REACTOR_EQUATES $INSERT MSG_EQUATES $INSERT POPUP_EQUATES $INSERT EXCEL_EQU $INSERT RLIST_EQUATES EQU COL$WMO_NO TO 1 EQU COL$BATCH_ID TO 2 EQU COL$IN_LOT_NO TO 3 EQU COL$IN_PART_NO TO 4 EQU COL$CASS_RDS_NO TO 5 EQU COL$CASS_RDS_WFR_CNT TO 6 EQU COL$CASS_RDS_REACT_NO TO 7 EQU COL$CASS_RDS_UNLOAD_DTM TO 8 EQU COL$CASS_RDS_MET_KEYS TO 9 EQU COL$CRM_RDS_NO TO 10 EQU COL$CRM_LS_ID TO 11 EQU COL$CRM_ZONE TO 12 EQU COL$CRM_THICK_AVG TO 13 EQU COL$CRM_HGCV1_RES_AVG TO 14 eXcelCols = 'A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,AA,BB,CC,DD,EE,FF,GG,HH,II,JJ,KK,LL' SWAP "','" WITH ',' IN eXcelCols CONVERT ',' TO @VM IN eXcelCols Set_Status(0) WMOKeys = Dialog_Box( 'DIALOG_EPIPRO_EXPORT', @WINDOW, '' ) IF Get_Status(errCode) THEN ErrMsg(ErrCode) OPEN 'WM_OUT' TO WMOTable ELSE ErrMsg('Unable to open RDS table in EXPORT_EPIPRO_MET for reporting') RETURN END OPEN 'DICT.WM_OUT' TO @DICT ELSE ErrMsg('Unable to open DICT.WM_OUT table in EXPORT_EPIPRO_MET for reporting') RETURN END SelectWMOKeys = WMOKeys SWAP @VM WITH '" "' IN SelectWMOKeys SelectWMOKeys = QUOTE(SelectWMOKeys) Void = Utility( 'CURSOR', 'H' ) Stmt = 'SELECT WM_OUT ':SelectWMOKeys:' BY WO_NO BY OUT_CASS_NO' RList( Stmt, TARGET_ACTIVELIST$, '', '', '' ) IF Get_Status(errCode) THEN ErrMsg(errCode) END DataArray = '' DataArray<1,COL$WMO_NO> = 'WMO No' DataArray<1,COL$BATCH_ID> = 'Batch ID' DataArray<1,COL$IN_LOT_NO> = 'In Lot No' DataArray<1,COL$IN_PART_NO> = 'In Part No' DataArray<1,COL$CASS_RDS_NO> = 'RDS No' DataArray<1,COL$CASS_RDS_REACT_NO> = 'Reactor' DataArray<1,COL$CASS_RDS_UNLOAD_DTM> = 'Unloaded' DataArray<1,COL$CASS_RDS_WFR_CNT> = 'RDS Wfr Cnt' DataArray<1,COL$CASS_RDS_MET_KEYS> = 'Met No' DataArray<1,COL$CRM_RDS_NO> = 'Met RDS No' DataArray<1,COL$CRM_LS_ID> = 'LS Id' DataArray<1,COL$CRM_ZONE> = 'Zone' DataArray<1,COL$CRM_THICK_AVG> = 'Thick Avg' DataArray<1,COL$CRM_HGCV1_RES_AVG> = 'HgCv1 Res Avg' NextLine = 2 AllRDSNos = '' Done = 0 LOOP READNEXT @ID ELSE Done = 1 UNTIL DONE READ @RECORD FROM WMOTable,@ID THEN WMONo = {WMO_NO} BatchID = {SAP_BATCH_NO} InLots = {IN_LOT_NO} InParts = {IN_PART_NO} CassRDSNos = {CASS_RDS_NO} CassRDSWfrCnts = {CASS_RDS_WFR_CNT} CassRDSReactNos = {CASS_RDS_REACT_NO} CassRDSUnloadDTMs = {CASS_RDS_UNLOAD_DTM} MetKeys = {CASS_RDS_MET_KEYS} MetRDSNos = {CRM_RDS_NO} LSIDs = {CRM_LS_ID} Zones = {CRM_ZONE} ThickAvgs = {CRM_THICK_AVG} HgCv1ResAvgs = {CRM_HGCV1_RES_AVG} LinePointer = 1 LOOP InLotNo = InLots<1,LinePointer> InPart = InParts<1,LinePointer> CassRDSNo = CassRDSNos<1,LinePointer> RdsWfrCnt = CassRDSWfrCnts<1,LinePointer> RDSReactNo = CassRDSReactNos<1,LinePointer> RDSUnloadDTM = OCONV(CassRDSUnloadDTMS<1,LinePointer>,'DT4/^S') MetKey = MetKeys<1,LinePointer> MetRDSNo = MetRDSNos<1,LinePointer> LSID = LSIDs<1,LinePointer> Zone = Zones<1,LinePointer> ThickAvg = ThickAvgs<1,LinePointer> HgCv1Avg = HgCv1ResAvgs<1,LinePointer> CassComp = 1 IF InLotNo NE '' THEN CassComp = 0 IF InPart NE '' THEN CassComp = 0 IF CassRDSNo NE '' THEN CassComp = 0 IF RdsWfrCnt NE '' THEN CassComp = 0 IF RDSReactNO NE '' THEN CassComp = 0 IF RDSUnloadDTM NE '' THEN CassComp = 0 IF MetKey NE '' THEN CassComp = 0 IF MetRDSNo NE '' THEN CassComp = 0 IF LSID NE '' THEN CassComp = 0 IF Zone NE '' THEN CassComp = 0 IF ThickAvg NE '' THEN CassComp = 0 IF HgCv1Avg NE '' THEN CassComp = 0 UNTIL CassComp = 1 DataArray = WMONo DataArray = BatchID DataArray = InLotNo DataArray = InPart DataArray = CassRdsNo DataArray = RdsWfrCnt DataArray = RDSReactNo DataArray = RDSUnloadDTM DataArray = MetKey DataArray = MetRDSNo DataArray = LSID DataArray = Zone DataArray = OCONV(ThickAvg,'MD2') DataArray = OCONV(HgCv1Avg,'MD3') NextLine += 1 LinePointer += 1 REPEAT NextLine += 1 END ;* End of RDS Read REPEAT xlApp = OleCreateInstance("excel.Application") ;* Create instance of Excel OlePutProperty(XlApp, 'Visible', xlSheetVisible) if OleStatus() then Goto HadError xlWorkBooks =OleGetProperty(xlApp, "Workbooks") ;* Create workbook xlWkb = OleCallMethod(xlWorkbooks,"Add") if OleStatus() then Goto HadError xlSht = OleGetProperty(xlWkb, "Worksheets",1) ;* Select worksheet 1 if OleStatus() then Goto HadError xlPageSetup = OleGetProperty(xlSht,"PageSetup") ;* Get PageSetup object for Page/Printing stuff if OleStatus() then GOTO HadError OlePutProperty( xlPageSetup , 'PrintGridLines', xlTrue ) ;* Print Gridlines on OlePutProperty( xlPageSetup , 'Orientation' , xlLandscape ) ;* Orientation to Landscape OlePutProperty( xlPageSetup , 'HeaderMargin', '20') ;* HeaderMargin to 20pts OlePutProperty( xlPageSetup , 'CenterHeader' , '&14Epi SERVICES - EpiPRO Metrology Data' ) ;* Set Center Header OlePutProperty( xlPageSetup , 'LeftHeader' , '&G' ) ;* Set graphic in Left Header graphic = OleGetProperty( xlPageSetup , 'LeftHeaderPicture' ) ;* Get graphic object for Left Header Picture OlePutProperty( graphic , 'FileName' , 'R:\Oinsight\BMPS\EpiSvcs.png' ) ;* Set filename for graphic OlePutProperty( graphic , 'Height' , '51.75' ) ;* Scale graphic to fit header OlePutProperty( graphic , 'Width' , '81') OlePutProperty( xlPageSetup , 'RightHeader' , 'Page &P' ) ;* Set Right Header to show current page number LineCnt = COUNT(DataArray,@FM) + (DataArray NE '') ColCnt = COUNT(DataArray<1>,@VM) + (DataArray<1> NE '') FOR LineNo = 1 TO LineCnt FOR Column = 1 to ColCnt RangeColumn = eXcelCols<1,Column> range = OleGetProperty( xlSht, 'Range',RangeColumn:LineNo) OlePutProperty(range, 'Value', DataArray) ;* Load report array into spreadsheet cells IF OleStatus() THEN GOTO HadError NEXT Column NEXT LineCnt LastColumn = eXcelCols<1,ColCnt> range = OleGetProperty( xlSht, 'Range','B1:':LastColumn:'1') ;* Turn on word wrap in columns from B through end OlePutProperty( range, 'WrapText', xlTrue) IF OleStatus() THEN GOTO HadError RangeColumn = eXcelCols<1,ColCnt> range = OleGetProperty( xlSht, 'Range','A1:':RangeColumn:LineCnt) Void = OleCallMethod( range, 'AutoFormat', xlRangeAutoFormatClassic1 ) ;* Turn on autoformat (FormatClassic1) IF OleStatus() THEN GOTO HadError /* FOR I = COL$Z1_MET_NO TO COL$Z2_HGCV_RESL2 eXcelCol = eXcelCols<1,I> column = OleGetProperty( xlSht, 'Range' , eXcelCol:':':exCelCol ) ;* Set the day columns to a standard width OlePutProperty( column , 'ColumnWidth' , '10.3' ) a = OleStatus() NEXT I */ EdgeList = xlDiagonalDown:@VM:xlDiagonalup:@VM:xlEdgeLeft:@VM:xlEdgeTop:@VM:xlEdgeRight:@VM:xlInsideVertical /* * Put border on the BOTTOM of this row range = OleGetProperty( xlSht, 'Range', 'A':ROW$TOT_YIELD:':':RangeColumn:ROW$TOT_OUT) FOR I = 1 TO COUNT(EdgeList,@VM) + (EdgeList NE '') edge = OleGetProperty( range, 'Borders' , EdgeList<1,I> ) OlePutProperty( edge , 'LineStyle' , xlLineStyleNone ) ;* Clear border segments EXCEPT bottom IF OleStatus() THEN debug NEXT I edge = OleGetProperty( range, 'Borders' , xlEdgeBottom ) ;* Set border segment for bottom to medium weight line olePutProperty( edge , 'LineStyle', xlContinuous ) olePutProperty( edge , 'Weight' , xlMedium ) olePutProperty( edge , 'ColorIndex', xlColorIndexAutomatic ) range = OleGetProperty( xlSht, 'Range', 'A':ROW$MER_YIELD:':':RangeColumn:ROW$TOT_OUT) ;* Set border for range (underline entire row) FOR I = 1 TO COUNT(EdgeList,@VM) + (EdgeList NE '') edge = OleGetProperty( range, 'Borders' , EdgeList<1,I> ) OlePutProperty( edge , 'LineStyle' , xlLineStyleNone ) NEXT I edge = OleGetProperty( range, 'Borders' , xlEdgeBottom ) olePutProperty( edge , 'LineStyle', xlContinuous ) olePutProperty( edge , 'Weight' , xlMedium ) olePutProperty( edge , 'ColorIndex', xlColorIndexAutomatic ) */ /* * This doesn't work void = OleCallMethod( xlPageSetup , 'Zoom' , 0 ) ;* error a = OleStatus() OlePutProperty( xlPageSetup , 'FitToPagesWide' , 1 ) if OleStatus() then GOTO HadError a = OleStatus() OlePutProperty( xlPageSetup , 'FitToPagesTall' , 1 ) if OleStatus() then GOTO HadError a = OleStatus() */ * Void = OleCallMethod( xlWkb, 'SaveAs','C:\OIReports\EpiData.xls', xlWorkbookNormal ) ;* Save to local drive Void = OleCallMethod( xlWkb, 'SaveAs',Environment_Services('GetReportsRootPath') : '\EpiData.xls', xlWorkbookNormal ) ;* Save to local drive RETURN * * * * * * * HadError: * * * * * * * xlChart = '' Charts = '' range = '' xlSht = '' xlWkb='' xlWorkBooks = '' x = OleCallMethod(xlApp, 'Quit') RETURN /* end of code */