COMPILE SUBROUTINE EXPORT_WALES_IGBT(ShipNo) * Compiles EpiPRO IGBT data for export to Wales * 09/10/2013 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 LOGICAL $INSERT EXCEL_EQU $INSERT RLIST_EQUATES $INSERT COC_EQUATES $INSERT WO_LOG_EQUATES $INSERT REACT_RUN_EQUATES $INSERT WO_MAT_EQUATES $INSERT WM_OUT_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 IF ShipNo = '' THEN RETURN 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 *ShipWreck = ;*** NO NO NO don't even go there... ShipRec = XLATE('COC',ShipNo,'','X') WONo = ShipRec PartNo = XLATE('WO_LOG',WONo,WO_LOG_CUST_PART_NO$,'X') WOSteps = ShipRec CassNos = ShipRec CassCnt = COUNT(CassNos,@VM) + (CassNos NE '') RDSTestKeys = '' CassIDSAPs = '' SAPBatchNos = '' FOR I = 1 TO CassCnt CassNo = CassNos<1,I> SAPBatchNo = XLATE('WO_MAT',WONo:'*':CassNo,WO_MAT_SAP_BATCH_NO$,'X') WMOKey = WONo:'*':WOSteps<1,I>:'*':CassNo READ WMORec FROM WMOTable,WMOKey THEN * Build RDSNos SlotCnt = COUNT(WMORec,@VM) + (WMORec NE '') CassRDSNos = '' FOR Slot = 1 TO SlotCnt RDSNo = WMORec LOCATE RDSNo IN CassRDSNOs BY 'AR' SETTING RPos ELSE CassRDSNos = INSERT(CassRDSNos,1,RPos,0,RDSNo) END NEXT SlotCnt RunLayerKeys = XLATE('REACT_RUN',CassRDSNos,REACT_RUN_RDS_LAYER_KEYS$,'X') CassTestKeys = XLATE('RDS_LAYER',RunLayerKeys,RDS_LAYER_RDS_TEST_KEYS$,'X') CTCnt = COUNT(CassTestKeys,@VM) + (CassTestKeys NE '') RTCNT = 0 FOR M = 1 TO CTCnt CassTestKey = CassTestKeys<1,M> LOCATE CassTestKey IN RDSTestKeys BY 'AR' USING @VM SETTING Pos THEN CassIDSAPs<1,Pos> = CassIDSAPs<1,Pos>:'-':WONo:'.':CassNo SAPBatchNos<1,Pos> = SAPBatchNos<1,Pos>:'-':SAPBatchNo END ELSE RDSTestKeys = INSERT(RDSTestKeys,1,Pos,0,CassTestKey) CassIDSAPs = INSERT(CassIDSAPs,1,Pos,0,WONo:'.':CassNo) SAPBatchNos = INSERT(SAPBatchNos,1,Pos,0,SAPBatchNo) RTCnt += 1 END NEXT M END NEXT I DEBUG 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 */