Sample xlsx code (feedback) (OpenInsight 32-bit)
At 07 OCT 2020 08:13:44AM Martin Drenovac wrote:
Over the past week some good people here have helped me with some very basic Excel q&a, and i'm grateful
so, here's a bit of proto code of what i was about with my questions
you should just run this and it will produce a nice excel sheet
i cannot use this forum editor so the boxes or non-printable chars in the code are actually @VM symbols
thank you
compile function mpd_excel( void ) // //------------------------------------------------------------------------------ // Check out https://docs.microsoft.com/en-us/office/vba/api/excel.xlborderweight as an example //------------------------------------------------------------------------------ $Insert MS_OFFICE_EQUATES $insert nv_excel_ins DECLARE function nv_error, Set_Property, rgb DECLARE subroutine check_assignments check_assignments( void ) work: objExcel@ = OleCreateInstance('Excel.Application') ; // oXl = OleCreateInstance('Excel.Application') objWorkBooks@ = OleGetProperty(objExcel@, 'Workbooks') ; // oWkBks = OleGetProperty(OXl, 'Workbooks') objWorkBook@ = OleCallMethod(objWorkBooks@, 'Add') ; // oWkBk = OleCallMethod(oWkbks, 'Add') // wait a second for excel to boot up now = time() LOOP CALL Yield() WHILE time() eq now REPEAT OlePutProperty(objExcel@, 'Visible', 1) unused = OleCallMethod(objWorkBook@ , 'Activate') oActiveSheet = OleGetProperty(objWorkBook@ , 'ActiveSheet') // GOSUB sample_1 ; // each of the pieces of code below create a .xlsx sheet GOSUB sample_2 ; // uncomment this to see 2nd version posn1 = FIELD(param, @VM:"Week 1",1,0) ; // pos of 1st week posn1_b = FIELD(param, @VM:"Week 2",2,0) mpd1 = col1() mpd2 = col2() posn2 = FIELD(param, @VM:"Week 2",1,0) ; // pos of 2nd week posn2_b = FIELD(param, @VM:"Week 2",2,0) mpd3 = col1() mpd4 = col2() param_items = DCOUNT(param,@FM) ; // anything here? a = 1 LOOP this_line = param<a> WHILE this_line[1,7] _nec @VM:"WEEK 1" ; // find where data grid starts a += 1 REPEAT week_1_start = a a = 1 LOOP this_line = param<a> WHILE this_line[1,7] _nec @VM:"WEEK 2" a += 1 REPEAT week_2_start = a no_data_rows = week_2_start - week_1_start - 3 ; // size of block //------------------------------------------------------------------------------ // this is a quick and easy means to populate the array //------------------------------------------------------------------------------ SWAP @VM WITH CHAR(9) IN param SWAP @FM WITH CHAR(13):CHAR(10) IN param //------------------------------------------------------------------------------ rv = Set_Property('CLIPBOARD', 'TEXT', Param) unused = OleCallMethod(oActiveSheet, 'Paste') GOSUB format_excel //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ // the following is a debug bucket for me, sorry for the mess //------------------------------------------------------------------------------ debug // uncomment the following lot to auto-save the .xlsx sheet // // status_save = OleCallMethod(osheet@, "SaveAs", newname2, ThisFormat, "", "") // GoSub check_ole_status * GOSUB close_workbook * close = OleCallMethod(objExcel@, 'Quit') * GOSUB check_ole_status * GOSUB destroy_excel_object RETURN //------------------------------------------------------------------------------ // this is the work // use week_1_start & week_2_start as the principal grid, the rest all bounces around them //------------------------------------------------------------------------------ format_excel: light_gray = rgb(242,242,242) light_blue = RGB(59,175,242) ; // 1st row col_a_Range = OleGetProperty(ObjExcel@,"Range","A:A") ; // select Col A:A (1st skinny col) cFont = OleGetProperty(col_a_Range, "Font") cFontName = OleGetProperty(cFont,"Name") col_k_Range = OleGetProperty(ObjExcel@,"Range","K:K") ; // 2nd outside cols of sheet OlePutProperty(col_a_Range,"ColumnWidth","8.43") OlePutProperty(col_k_Range,"ColumnWidth","8.43") // Columns("B:H").Select // Selection.ColumnWidth = 17.43 // cols_bc_Range = OleGetProperty(ObjExcel@,"Range","B:C") ; // 2 cols of titles cols_dj_Range = OleGetProperty(ObjExcel@,"Range","D:J") ; // B,C can't wrap, the week's grid OlePutProperty(cols_bc_Range,"ColumnWidth","25.00") OlePutProperty(cols_dj_Range,"ColumnWidth","25.50") OlePutProperty(cols_dj_Range,"WrapText",1) ; // this grid can wrap text //------------------------------------------------------------------------------ // Do some with rows //------------------------------------------------------------------------------ row_1_height = OleGetProperty(ObjExcel@,"Rows","1:1") OlePutProperty(row_1_height,"rowheight","39.50") OlePutProperty(row_1_height,"MergeCells", -1) row_1_interior = OleGetProperty(row_1_height, "Interior") OlePutProperty(row_1_interior,"Color", light_blue) row_2_height = OleGetProperty(ObjExcel@,"Rows","2:2") OlePutProperty(row_2_height,"rowheight","24.75") row_2_Range = OleGetProperty(ObjExcel@,"Range","A2:H2") OlePutProperty(row_2_Range,"MergeCells", -1) row_3_Range = OleGetProperty(ObjExcel@,"Range","A3:H3") OlePutProperty(row_3_Range,"MergeCells", -1) //------------------------------------------------------------------------------ // Insert Graphic // am not sure of what combination here has made it all work, but it does //------------------------------------------------------------------------------ * Range("I3").Select * ActiveSheet.Pictures.Insert("F:\temp\edmen\dcp\dcp-graphic.png").Select * End Sub png_location = "F:\temp\edmen\dcp\dcp-graphic.png" graphic_cell = OleGetProperty(ObjExcel@,"Range","I3") selVal = oleCallMethod( graphic_cell, "Select" ) objSheet = oleGetProperty( ObjExcel@, "ActiveSheet" ) objPix = oleGetProperty( objSheet, "Pictures" ) objPic = oleCallMethod( objPix, "Insert", "F:\temp\edmen\dcp\dcp-graphic.png" ) row_24_height = OleGetProperty(ObjExcel@,"Rows","2:4") OlePutProperty(row_24_height,"rowheight","24.75") row_4_height = OleGetProperty(ObjExcel@,"Range","A4:K4") OlePutProperty(row_4_height,"MergeCells", -1) row_4_font = OleGetProperty(row_4_height,"Font") OlePutProperty(row_4_font, "Bold", -1) OlePutProperty(row_4_height,'HorizontalAlignment', xlCenter) ; // EQU xlCenter TO -4108 //------------------------------------------------------------------------------ // now change font //------------------------------------------------------------------------------ OlePutProperty(row_4_font,"Name","Calibri") OlePutProperty(row_4_font,"Size","18") //------------------------------------------------------------------------------ // Row 11 //------------------------------------------------------------------------------ row_11_range = OleGetProperty(ObjExcel@,"Range","I11:J11") OlePutProperty(row_11_range,"MergeCells", -1) //------------------------------------------------------------------------------ // 2 col header blocks around Week 1 & 2 //------------------------------------------------------------------------------ * Sub selectColWeek1() * ' * ' selectColWeek1 Macro * ' * Range("B13:C20").Select * Application.CutCopyMode = False * With Selection.Interior * .Pattern = xlSolid * .PatternColorIndex = xlAutomatic * .ThemeColor = xlThemeColorDark1 * .TintAndShade = -4.99893185216834E-02 * .PatternTintAndShade = 0 * End With * Application.Left = -1664.5 * Application.Top = -472 * Windows("2020_10_09_Vivienne (Edmen).xlsx").Activate * End Sub w1_range = "B":week_1_start:":C":week_1_start + no_data_rows + 1 ; // +1, because 2 lines of headers week1_block = OleGetProperty(ObjExcel@,"Range", w1_range ) week1_interior = OleGetProperty(week1_block, "Interior") // OlePutProperty(week1_interior,"TintAndShade", RGB(255, 0, 0)) ; // .Color = 13434879 OlePutProperty(week1_interior,"Color", light_gray) w2_range = "B":week_2_start:":C":week_2_start + no_data_rows + 1 ; // +1, because 2 lines of headers week2_block = OleGetProperty(ObjExcel@,"Range", w2_range ) week2_interior = OleGetProperty(week2_block, "Interior") * OlePutProperty(week2_interior,"TintAndShade", RGB(255, 0, 0)) ; // .Color = 13434879 OlePutProperty(week2_interior,"Color", light_gray) //------------------------------------------------------------------------------ // Still on the headers, now do the rows //------------------------------------------------------------------------------ w1_range = "D":week_1_start:":J":week_1_start + 1 week1_block = OleGetProperty(ObjExcel@,"Range", w1_range ) week1_interior = OleGetProperty(week1_block, "Interior") * OlePutProperty(week2_interior,"TintAndShade", RGB(255, 0, 0)) ; // .Color = 13434879 OlePutProperty(week1_interior,"Color", light_gray) OlePutProperty(week1_block,"VerticalAlignment",xlCenter) OlePutProperty(week1_block,"HorizontalAlignment",xlCenter) w2_range = "D":week_2_start:":J":week_2_start + 1 week2_block = OleGetProperty(ObjExcel@,"Range", w2_range ) week2_interior = OleGetProperty(week2_block, "Interior") * OlePutProperty(week2_interior,"TintAndShade", RGB(255, 0, 0)) ; // .Color = 13434879 OlePutProperty(week2_interior,"Color", light_gray) OlePutProperty(week2_block,"VerticalAlignment",xlCenter) OlePutProperty(week2_block,"HorizontalAlignment",xlCenter) //------------------------------------------------------------------------------ // Align / Format Cols B:C //------------------------------------------------------------------------------ OlePutProperty(cols_bc_Range,"HorizontalAlignment",xlCenter) OlePutProperty(cols_bc_Range,"VerticalAlignment",xlCenter) //------------------------------------------------------------------------------ // for whatever reason, the lower legend is aligned hard left, so fix it //------------------------------------------------------------------------------ * Sub Macro1() * Range("B43").Select * With Selection * .HorizontalAlignment = xlLeft * .VerticalAlignment = xlCenter * .WrapText = False * .Orientation = 0 * .AddIndent = False * .IndentLevel = 0 * .ShrinkToFit = False * .ReadingOrder = xlContext * .MergeCells = False * End With * End Sub legend_range = "B":week_2_start + (no_data_rows + 1 + 7 ) :":B":week_2_start + (no_data_rows + 1 + 7 + 8) legend_block = OleGetProperty(ObjExcel@,"Range", legend_range ) OlePutProperty(legend_block,"HorizontalAlignment",xlLeft) legend_interior = OleGetProperty(legend_block, "Interior") // OlePutProperty(week2_interior,"TintAndShade", RGB(255, 0, 0)) ; // .Color = 13434879 // OlePutProperty(legend_interior,"Color", RGB(200, 200, 100)) //------------------------------------------------------------------------------ // Individual elements just need a tweak //------------------------------------------------------------------------------ c5 = OleGetProperty(ObjExcel@,"Range", "C5" ) OlePutProperty(c5,"HorizontalAlignment",xlLeft) c6 = OleGetProperty(ObjExcel@,"Range", "C6" ) c6_font = OleGetProperty(c6,"Font") OlePutProperty(c6_font,"Color", -16776961) * Range("B6").Select * Selection.Font.Underline = xlUnderlineStyleSingle * placement = OleGetProperty(ObjExcel@,"Range", "B8" ) placement_font = OleGetProperty(placement,"Font") OlePutProperty(placement_font, "Underline", xlUnderlineStyleSingle) OlePutProperty(placement_font, "Bold", -1) // Guidelines Header legend_range = "B":week_2_start + (no_data_rows + 1 + 7 ) ; // legend = OleGetProperty(ObjExcel@,"Range", legend_range ) legend_font = OleGetProperty(legend,"Font") OlePutProperty(legend_font, "Bold", -1) //------------------------------------------------------------------------------ // Box the Legend headers //------------------------------------------------------------------------------ * sub macro1() * * range("j32:j34").select * selection.borders(xldiagonaldown).linestyle = xlnone * selection.borders(xldiagonalup).linestyle = xlnone * with selection.borders(xledgeleft) * .linestyle = xlcontinuous * .colorindex = 0 * .tintandshade = 0 * .weight = xlthin * end with * with selection.borders(xledgetop) * .linestyle = xlcontinuous * .colorindex = 0 * .tintandshade = 0 * .weight = xlthin * end with * with selection.borders(xledgebottom) * .linestyle = xlcontinuous * .colorindex = 0 * .tintandshade = 0 * .weight = xlthin * end with * with selection.borders(xledgeright) * .linestyle = xlcontinuous * .colorindex = 0 * .tintandshade = 0 * .weight = xlthin * end with * with selection.borders(xlinsidevertical) * .linestyle = xlcontinuous * .colorindex = 0 * .tintandshade = 0 * .weight = xlthin * end with * with selection.borders(xlinsidehorizontal) * .linestyle = xlcontinuous * .colorindex = 0 * .tintandshade = 0 * .weight = xlthin * end with * end sub legend_range = "J":week_2_start + (no_data_rows + 3 ):":J":week_2_start + (no_data_rows + 1 + 5) legend = OleGetProperty(ObjExcel@,"Range", legend_range ) borders = OleGetProperty(legend, "BORDERS") OlePutProperty(borders, "LineStyle",XlContinuous) OlePutProperty(borders, "Weight",XlThin) OlePutProperty(legend, "HorizontalAlignment",xlCenter) RETURN ///////////////////////////////////////////////////////////////////////////////// // Closes excel altogether. Should probably call this on the close of Pf just in case. // Don't do it each time though because starting excel is time consuming. ///////////////////////////////////////////////////////////////////////////////// destroy_excel_object: void = OLECallMethod(objExcel@, 'Close') objExcel@ = "" ; // Set it to null so that if we come here again we'll know excel is no longer instantiated * added_records += 1 * IF added_records > 0 THEN * @user1 := @VM: added_records:@FM:"Actual sheets in file:":@FM:local_sheets * END RETURN 0 ///////////////////////////////////////////////////////////////////////////////// // Close the current workbook. Have this separate so we can close the workbook // without also closing excel altogether. Starting excel is time consuming. ///////////////////////////////////////////////////////////////////////////////// close_workbook: void = OLECallMethod(objWorkBooks@, 'Close') ; // 01/03/12 objWorkBook@ = "" objWorkBookS@ = "" Return //////////////////////////////////////////////////////////////////////////////// // Only way to accurately tell whether the previous ole command was successful //////////////////////////////////////////////////////////////////////////////// check_ole_status: is_ok = ( oleStatus() eq 0 ) // IF is_ok = 0 THEN DEBUG Return //------------------------------------------------------------------------------ // these 2 structures are headed for print grid, however we needed an actual ".xlsx" file //------------------------------------------------------------------------------ sample_1: x = "" x<-1> = "" x<-1> = "" x<-1> = "" x<-1> = "AGENCY ENGAGEMENT ROSTER" x<-1> = "Statement ID: DCPCOUNTRYMTGAMBIER11VIVIENNE_2020_10_09 (Fortnight Ending)" x<-1> = "Service Provider:Edmen" x<-1> = "" x<-1> = "Placement Details" x<-1> = "11 VIVIENNE AVENUE" x<-1> = "MOUNT GAMBIER 5290" x<-1> = "0410 412 569 Fortnight ending:Friday 09 October 2020" x<-1> = "" x<-1> = "WEEK 1 SHIFT TIMES SaturdaySundayMondayTuesdayWednesdayThursdayFriday" x<-1> = "26/09/2027/09/2028/09/2029/09/2030/09/2001/10/2002/10/20" x<-1> = "AM SHIFT06:50-15:00ASHLEIGH MABBOTT" x<-1> = "PM SHIFT14:50-23:00ASHLEIGH MABBOTTDANIELLE HERSEYDANIELLE HERSEY" x<-1> = "" x<-1> = "WEEK 2 SHIFT__TIMES SaturdaySundayMondayTuesdayWednesdayThursdayFriday" x<-1> = "03/10/2004/10/2005/10/2006/10/2007/10/2008/10/2009/10/20" x<-1> = "AM SHIFT06:50-15:00DANIELLE HERSEY" x<-1> = "PM SHIFT14:50-23:00" x<-1> = "" x<-1> = "LEGEND" x<-1> = "STAFF REQUIRED" x<-1> = "STAFF NOT REQUIRED" x<-1> = "STAFF AMENDED" x<-1> = "" x<-1> = "Guidelines" x<-1> = "The completed roster must be submitted to the DCP Central Rostering Team (CRT) mailbox DCPRosteringandDeployment@sa.gov.au within response times outlined in section 2.8 of schedule 4" x<-1> = "If an incomplete roster is submitted an updated version must be provided to CRT before any applicable shifts commence" x<-1> = "If any staff changes occur an updated roster must be provided to CRT before the commencement of the shift" x<-1> = "The roster must accuratley reflect the full name of staff members working in the placement" x<-1> = "Rostered contracor staff are qualified as outlined in section 6.2 of schedule 1" x<-1> = "Overtime rates must not be applied without written approval of the Minister prior to the commencement of work" x<-1> = "Roster cost must be provided based on the total number of shifts requested for the roster period incusive of applicable rates" x<-1> = "Minister Respresentative: Sam Armitage" Transfer x TO param RETURN //------------------------------------------------------------------------------ // like above, but more data rows //------------------------------------------------------------------------------ sample_2: x = "" x<-1> = "" x<-1> = "" x<-1> = "" x<-1> = "AGENCY ENGAGEMENT ROSTER" x<-1> = "Statement ID: DCPCOUNTRYMTGAMBIER11VIVIENNE_2020_10_09 (Fortnight Ending)" x<-1> = "Service Provider:Edmen" x<-1> = "" x<-1> = "Placement Details" x<-1> = "130 WARREN ROAD" x<-1> = "MODBURY NORTH 5092" x<-1> = "0410 412 569 Fortnight ending:Friday 09 October 2020" x<-1> = "" x<-1> = "WEEK 1 SHIFT TIMES MondayTuesdayWednesdayThursdayFridaySaturdaySunday" x<-1> = "21/09/2022/09/2023/09/2024/09/2025/09/2026/09/2027/09/20" x<-1> = "AM SHIFT06:50-15:00ASHLEIGH MABBOTT" x<-1> = "PM SHIFT14:50-23:00ASHLEIGH MABBOTTDANIELLE HERSEYDANIELLE HERSEY" x<-1> = "TODO16:46-06:30FOLUSO OMOLE" x<-1> = "TODO16:46-06:30PETER JAY" x<-1> = "NIGHT SHIFT22:20-06:30YUANG THUONGYUANG THUONGFOLUSO OMOLEYUANG THUONGFOLUSO OMOLEFOLUSO OMOLEGANDHI OMILABU" x<-1> = "TODO22:20-06:30GANDHI OMILABUGANDHI OMILABUVIRGINIA STUART" x<-1> = "NIGHT SHIFT22:20-06:30GANDHI OMILABU" x<-1> = "TODO22:23-06:30GANDHI OMILABUFOLUSO OMOLE" x<-1> = "" x<-1> = "WEEK 2 SHIFT__TIMES MondayTuesdayWednesdayThursdayFridaySaturdaySunday" x<-1> = "28/09/2029/09/2030/09/2001/10/2002/10/2003/10/2004/10/20" x<-1> = "AM SHIFT06:50-15:00DANIELLE HERSEY" x<-1> = "PM SHIFT14:50-23:00" x<-1> = "TODO16:46-06:30" x<-1> = "TODO16:46-06:30" x<-1> = "NIGHT SHIFT22:20-06:30" x<-1> = "TODO22:20-06:30" x<-1> = "NIGHT SHIFT22:20-06:30" x<-1> = "TODO22:23-06:30" x<-1> = "" x<-1> = "LEGEND" x<-1> = "STAFF REQUIRED" x<-1> = "STAFF NOT REQUIRED" x<-1> = "STAFF AMENDED" x<-1> = "" x<-1> = "Guidelines" x<-1> = "The completed roster must be submitted to the DCP Central Rostering Team (CRT) mailbox DCPRosteringandDeployment@sa.gov.au within response times outlined in section 2.8 of schedule 4" x<-1> = "If an incomplete roster is submitted an updated version must be provided to CRT before any applicable shifts commence" x<-1> = "If any staff changes occur an updated roster must be provided to CRT before the commencement of the shift" x<-1> = "The roster must accuratley reflect the full name of staff members working in the placement" x<-1> = "Rostered contracor staff are qualified as outlined in section 6.2 of schedule 1" x<-1> = "Overtime rates must not be applied without written approval of the Minister prior to the commencement of work" x<-1> = "Roster cost must be provided based on the total number of shifts requested for the roster period incusive of applicable rates" x<-1> = "Minister Respresentative: Sam Armitage" Transfer x TO param RETURN
At 07 OCT 2020 09:20AM Andrew McAuley wrote:
Looks comprehensive - thank you! Of course, we'll need the equates to see it in action :D
World leaders in all things RevSoft
At 07 OCT 2020 05:22PM Martin Drenovac wrote:
Compile Insert MS_OFFICE_EQUATES * * Excel OLE Equates * Declare Function OlePutProperty, OleSetProperty * * General * equ xlFalse to 0 equ xlTrue to -1 equ xlAll to -4104 equ xlNone to -4142 * * Orientation * equ xlPortrait to 1 equ xlLandscape to 2 * * Line Positions * equ xlEdgeLeft to 7 equ xlEdgeTop to 8 equ xlEdgeBottom to 9 equ xlEdgeRight to 10 equ xlInsideVertical to 11 equ xlInsideHorizontal to 12 * * Lines * equ xlHairline to 1 equ xlThin to 2 equ xlMedium to -4138 equ xlThick to 4 * * Horizontal Alignment * equ xlLeft to -4131 equ xlCenter to -4108 equ xlRight to -4152 * * Vertical Alignment * equ xlVAlignBottom to -4107 equ xlVAlignCenter to -4108 equ xlVAlignTop to -4160 * * Underline * equ xlUnderlineStyleNone to -4142 equ xlUnderlineStyleDouble to -4119 equ xlUnderlineStyleSingle to 2 equ xlUnderlineStyleSingleAccounting to 4 equ xlUnderlineStyleDoubleAccounting to 5 equ xlPageBreakManual to -4135 * * Calculation * equ xlManual to -4135 equ xlAutomatic to -4105/////////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////////////////////////////// EQU MergeCells TO 1 // EQU xlCenter TO -4108 ;* 3 EQU xlSheetVisible TO 1 /////////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////////////////////////////// EQU xlContinuous TO 1 ; // Continuous line. EQU xlDash TO -4115 ; // Dashed line. EQU xlDashDot TO 4 ; // Alternating dashes and dots. EQU xlDashDotDot TO 5 ; // Dash followed by two dots. EQU xlDot TO -4118 ; // Dotted line. EQU xlDouble TO -4119 ; // Double line. EQU xlLineStyleNone TO -4142 ; //No line. EQU xlSlantDashDot TO 13 ; // Slanted dashes.