COMPILE SUBROUTINE REPORT_EPI_MET_DATA(Dummy) * EPI Metrology Data Report - goes straight to Excel * 12/14/2006 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$WO_NO TO 1 EQU COL$RDS_NO TO 2 EQU COL$REACTOR TO 3 EQU COL$Z1_MET_NO TO 4 EQU COL$Z1_THICKNESS TO 5 EQU COL$Z1_4PP_SHEET_RHO TO 6 EQU COL$Z1_HGCV_RESL1 TO 7 EQU COL$Z1_HGCV_RESL2 TO 8 EQU COL$Z2_MET_NO TO 9 EQU COL$Z2_THICKNESS TO 10 EQU COL$Z2_4PP_SHEET_RHO TO 11 EQU COL$Z2_HGCV_RESL1 TO 12 EQU COL$Z2_HGCV_RESL2 TO 13 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) WOKeys = obj_WO_Log('Find') IF Get_Status(errCode) THEN ErrMsg(ErrCode) IF WOKeys NE '' THEN TypeOver = '' TypeOver = WOKeys TypeOver = 'K' WOKeys = Popup(@WINDOW,TypeOver,'WO_LOG_QUERY') IF Get_Status(errCode) THEN ErrMsg(errCode) END IF WOKeys = '' THEN RETURN END OPEN 'RDS' TO RdsTable ELSE ErrMsg('Unable to open RDS table in REPORT_EPI_MET_DATA for reporting') RETURN END OPEN 'DICT.RDS' TO @DICT ELSE ErrMsg('Unable to open DICT.RDS table in REPORT_EPI_MET_DATA for reporting') RETURN END SelectWONos = WOKeys SWAP @vm WITH '" "' IN SelectWONos SelectWONos = QUOTE(SelectWONos) Void = Utility( 'CURSOR', 'H' ) Stmt = 'SELECT RDS WITH WO = ':SelectWONos:' BY WO BY @ID' RList( Stmt, TARGET_ACTIVELIST$, '', '', '' ) IF Get_Status(errCode) THEN ErrMsg(errCode) END DataArray = '' DataArray<1,COL$WO_NO> = 'WO No' DataArray<1,COL$RDS_NO> = 'RDS No' DataArray<1,COL$REACTOR> = 'Reactor' DataArray<1,COL$Z1_MET_NO> = 'Z1 Met No' DataArray<1,COL$Z1_THICKNESS> = 'Z1 Thickness' DataArray<1,COL$Z1_4PP_SHEET_RHO> = 'Z1 4PP Sheet Rho' DataArray<1,COL$Z1_HGCV_RESL1> = 'Z1 HgCV Res L1' DataArray<1,COL$Z1_HGCV_RESL2> = 'Z1 HgCV Res L2' DataArray<1,COL$Z2_MET_NO> = 'Z2 Met No' DataArray<1,COL$Z2_THICKNESS> = 'Z2 Thickness' DataArray<1,COL$Z2_4PP_SHEET_RHO> = 'Z2 4PP Sheet Rho' DataArray<1,COL$Z2_HGCV_RESL1> = 'Z2 HgCV Res L1' DataArray<1,COL$Z2_HGCV_RESL2> = 'Z2 HgCV Res L2' NextLine = 2 Done = 0 LOOP READNEXT @ID ELSE Done = 1 UNTIL DONE READ @RECORD FROM RdsTable,@ID THEN WONo = @RECORD WOStep = FIELD(@RECORD,'*',2) Reactor = @RECORD LSKeys = @RECORD Z1MetKeys = {MET_KEYS_Z1} Z2MetKeys = {MET_KEYS_Z2} Z1MetNo = Z1MetKeys[-1,'B':@VM] Z2MetNo = Z2MetKeys[-1,'B':@VM] Z1MetRec = XLATE('RDS_TEST',Z1MetNo,'','X') Z2MetRec = XLATE('RDS_TEST',Z2MetNo,'','X') Z1TestPointMap = Z1MetRec Z2TestPointMap = Z2MetRec Z1MetReadings = '' Z2MetReadings = '' Z1Results = '' Z2Results = '' Z1MetKeyCnt = COUNT(Z1MetKeys,@VM) + (Z1MetKeys NE '') FOR I = 1 TO Z1MetKeyCnt Z1MetKey = Z1MetKeys<1,I> Z1LMetReadings = obj_RDS_Test('GetReadSet',Z1MetKey) IF I = 1 THEN Z1MetReadings<1> = Z1LMetReadings<1> ;* Line Numbers Z1MetReadings<3> = Z1LMetReadings<3> ;* SheetRho Z1MetReadings<4> = Z1LMetReadings<4> ;* Hgcv END IF Z1MetKeyCnt = 1 THEN Z1MetReadings<2> = Z1LMetReadings<2> ;* Thickness readings END ELSE IF I = 2 THEN Z1MetReadings<5> = Z1LMetReadings<4> ;* Hgcv IF I = 3 THEN Z1MetReadings<2> = Z1LMetReadings<2> ;* Thickness readings END NEXT I IF Z1MetReadings<1> NE '' THEN CONVERT @FM TO @RM IN Z1MetReadings oTPM_Parms = Z1TestPointMap:@RM:Z1MetReadings Z1Results = obj_Test_Point_Map('PointToResult',oTPM_Parms) END Z2MetKeyCnt = COUNT(Z2MetKeys,@VM) + (Z2MetKeys NE '') FOR I = 1 TO Z2MetKeyCnt Z2MetKey = Z2MetKeys<1,I> Z2LMetReadings = obj_RDS_Test('GetReadSet',Z2MetKey) IF I = 1 THEN Z2MetReadings<1> = Z2LMetReadings<1> ;* Line Numbers Z2MetReadings<3> = Z2LMetReadings<3> ;* SheetRho Z2MetReadings<4> = Z2LMetReadings<4> ;* Hgcv END IF Z2MetKeyCnt = 1 THEN Z2MetReadings<2> = Z2LMetReadings<2> ;* Thickness readings END ELSE IF I = 2 THEN Z2MetReadings<5> = Z2LMetReadings<4> ;* Hgcv IF I = 3 THEN Z2MetReadings<2> = Z2LMetReadings<2> ;* Thickness readings END NEXT I IF Z2MetReadings<1> NE '' THEN CONVERT @FM TO @RM IN Z2MetReadings oTPM_Parms = Z2TestPointMap:@RM:Z2MetReadings Z2Results = obj_Test_Point_Map('PointToResult',oTPM_Parms) END Z1Cnt = COUNT(Z1Results<1>,@VM) + (Z1Results<1> NE '') Z2Cnt = COUNT(Z2Results<1>,@VM) + (Z2Results<1> NE '') ResultCnt = Z1Cnt IF Z2Cnt > ResultCnt THEN ResultCnt = Z2Cnt IF ResultCnt = 0 THEN DataArray = WONo DataArray = Reactor DataArray = @ID DataArray = Z1MetNo DataArray = Z2MetNo NextLine += 1 END FOR N = 1 TO ResultCnt IF N = 1 THEN DataArray = WONo DataArray = Reactor DataArray = @ID DataArray = Z1MetNo DataArray = Z2MetNo END DataArray = Z1Results<2,N> DataArray = Z1Results<3,N> DataArray = Z1Results<4,N> DataArray = Z1Results<5,N> DataArray = Z2Results<2,N> DataArray = Z2Results<3,N> DataArray = Z2Results<4,N> DataArray = Z2Results<5,N> NextLine += 1 NEXT N * * * * * * * * * * * 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 */