OI Excel interface#
Introduction#
Recently had the need to generate explicit ".xlsx" out of OI. This is a collecction of useful links to document
Documentation Links#
- Hex / RGB / MS Access Color Values
- Shapes.AddPicture method (Excel)
- VBA Excel 2010 - Embedding Pictures and Resizing
- How to insert a picture into Excel at a specified cell position with VBA](https://stackoverflow.com/questions/12936646/how-to-insert-a-picture-into-excel-at-a-specified-cell-position-with-vba)
Appendix - code#
This function takes in effectively the 'ADDTABLE' guts of a printjob
cudcp01#
compile function cudcp01( directive, param, excel_to_email )
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//
// This program is proprietary and is not to be used by or disclosed to others,
// nor is it to be copied without written permission from Envizion Systems Pty Ltd.
//
// Name :
//
// Description: (E) DCP create export file format of shift confirmation
//
// * @package PowerForce
// * @author Martin Drenovac (for Envizion Systems Pty Ltd)
// * @copyright Copyright (c) 2007 - @present, Envizion Systems Pty Ltd
// * @licence http://powerforcesoftware.com/user/license.html
// * @link http://powerforcesoftware.com
// * @since Version 1.0
//
// History (Date, Initials, Notes)
// 08/10/20 mpd Original programmer
// 10/10/20 mpd embed image
//
// Date: 2020/10/08 17:34:22 +1000 (Thu 08 Oct 2020)
//------------------------------------------------------------------------------
// // Check out https://docs.microsoft.com/en-us/office/vba/api/excel.xlborderweight as an example
//------------------------------------------------------------------------------
#PRAGMA OUTPUT SYSLISTS mpd_cudcp01
$INSERT nv_copyright
$INSERT nv_userprefs
$Insert MS_OFFICE_EQUATES
$insert nv_excel_ins
DECLARE function nv_error, rgb, Set_Property
DECLARE subroutine check_assignments
check_assignments( directive, param, excel_to_email ) ; // html_to_email -> filename to save as
nv_version$$ = "[ver: k284]"
IF directive[1,5] _eqc ver$$ THEN
RETURN nv_version$$
END
retval = ""
BEGIN CASE
CASE directive _eqc 'a' ; NULL
CASE 1 ; GOSUB work
END CASE
If Assigned(retval) else retval = ""
RETURN retval
//------------------------------------------------------------------------------
// retval needs to be name of file_name.xlsx to append
//------------------------------------------------------------------------------
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')
//------------------------------------------------------------------------------
// param represents the otherwise set_printer('add...') grid
// it's a specific layout to correspond to the sample provided to us to work off
//------------------------------------------------------------------------------
posn1 = FIELD(param, @VM:"Week 1",1,0) ; // pos of 1st week in data
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, so we can work offsets
posn2_b = FIELD(param, @VM:"Week 2",2,0)
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
//------------------------------------------------------------------------------
// quickest way i know how to populate excel grid
//------------------------------------------------------------------------------
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
//------------------------------------------------------------------------------
ThisFile = OleGetProperty(objWorkBook@, 'FullName')
ThisFormat = OleGetProperty(objWorkBook@, 'FileFormat')
status_save = OleCallMethod(objWorkBook@, "SaveAs", excel_to_email, ThisFormat, "", "")
GoSub check_ole_status
GOSUB close_workbook
close = OleCallMethod(objExcel@, 'Quit')
GOSUB check_ole_status
GOSUB destroy_excel_object
//------------------------------------------------------------------------------
// TODO return the filename to caller
//------------------------------------------------------------------------------
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" )
objActiveSheet = oleGetProperty( ObjExcel@, "ActiveSheet" )
GOSUB check_ole_status
/////////////// BELOW works perfectly, but insert link to image...
* objPictures = oleGetProperty( objActiveSheet, "Pictures" )
* GOSUB check_ole_status
*
* objPic = oleCallMethod( objPictures, "Insert", "F:\temp\edmen\dcp\dcp-graphic.png" )
* GOSUB check_ole_status
////////////// ABOVE works perfectly
EQU msoFalse TO 0
EQU msoCTrue TO 1
EQU msoTrue TO -1
objShapes = oleGetProperty( objActiveSheet, "Shapes" )
GOSUB check_ole_status
//------------------------------------------------------------------------------
// This from doco
* Dim objPicture As Object
* Set objPicture = ActiveSheet.Shapes.AddPicture( _
* Filename:="C:\Logotypes\OldOne.jpg", _
* LinkToFile:=False, _
* SaveWithDocument:=True, _
* Left:=Range("C2").Left, _
* Top:=Range("C2").Top, _
* Width:=-1, _
* Height:=-1) '-1 = keep size
//------------------------------------------------------------------------------
// This as practical example -
//------------------------------------------------------------------------------
// https://docs.microsoft.com/en-us/office/vba/api/excel.shapes.addpicture
* Set myDocument = Worksheets(1)
* myDocument.Shapes.AddPicture _
* "c:\microsoft office\clipart\music.bmp", _
* True, True, 100, 100, 70, 70
//------------------------------------------------------------------------------
cell_top = oleGetProperty(graphic_Cell,"Top")
cell_left = oleGetProperty(graphic_Cell,"Left")
fileName = "f:\temp\edmen\dcp\dcp-graphic.png"
objShape = oleCallMethod( objShapes, "AddPicture", filename,msoFalse,msoTrue,cell_left,cell_top, -1, -1)
GOSUB check_ole_status
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)
//------------------------------------------------------------------------------
// just sampler to see entering data into header
//------------------------------------------------------------------------------
* Sub InsertPicture()
*
* With ActiveSheet.PageSetup.LeftHeaderPicture
* .FileName = "C:\Sample.jpg"
* .Height = 275.25
* .Width = 463.5
* .Brightness = 0.36
* .ColorType = msoPictureGrayscale
* .Contrast = 0.39
* .CropBottom = -14.4
* .CropLeft = -28.8
* .CropRight = -14.4
* .CropTop = 21.6
* End With
*
* ' Enable the image to show up in the left header.
* ActiveSheet.PageSetup.LeftHeader = "&G"
*
* End Sub
* HeaderPicture=OleGetProperty(PageSetup,"LeftHeaderPicture")
* OlePutProperty(PageSetup,"LeftHeader","&G")
* OlePutProperty(HeaderPicture,"Filename",ADD_TEXT)
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
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 )
Return