Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
29246 Discussions

AUTODICE problems - OLE/automation

isn-removed200637
2,970 Views
I have posted this and other quieries to VF-support but have
received no replies so I will try here...

I am using CVF 6.6 Pro.
I am a newbie as far as OLE/automation is concerned so
I started with the AUTODICE example and eventually got
it to work on my system using EXCEL 2000.

The AUTODICE example fills 12 cells in the first row
of an EXCEL sheet, beginning at A1 (R1C1) and ending
at L1 (R1C12). with randomly generated dice values
and charts the numbers as they are generated (in
steps of 200 throws).

The EXCEL cell range is defined as follows in the AUTODICE.F90 file:
	! Create a new chart
CALL VariantInit(vBSTR1)
vBSTR1%VT = VT_BSTR
bstr1 = ConvertStringToBSTR("A1")
vBSTR1%VU%PTR_VAL = bstr1
CALL VariantInit(vBSTR2)
vBSTR2%VT = VT_BSTR
bstr2 = ConvertStringToBSTR("L1")
vBSTR2%VU%PTR_VAL = bstr2
range = $Worksheet_GetRange(worksheet, vBSTR1, vBSTR2, status)
CALL Check_Status(status, " Unable to get RANGE object")


'range' is then used in later calls to AUTOSETPROPERTY
to update the contents of the EXCEL cells in the range
with the contents of single-dimension array 'cellCounts'
e.g.
status = AUTOSETPROPERTY (range, "VALUE", cellCounts)

I have tried replacing "L1" with "A12" in order to get
the numbers into the first 12 cells in the first column instead,
just to see how flexible the example is, for
future reference.
I recompiled, linked and executed,
with just this single change. The result is an EXCEL
sheet with a column of 12 zeros (in A1:A12, or R1C1:R12C1)
and the chart plots these zeros out ok. There were no
error messages. Any ideas as to the reason for the failure
to change the cell contents to the generated values?

I have also tried initialising the cells using the index
'i', i.e. CellCount(i) = i and found, when using the range
"A1" to "A12" that the initial (and final) contents of all
12 cells A1:A12 was 1 instead of ranging from 1 to 12.
There was no change to their values as the number of dice
throws increased from 1 to its maximum. Again, there were
no error messages. Any ideas as to the cause and the remedy?

(When I switched back to using range values "A1" and "L1",
the cell contents were correctly displayed as 1 to 12
initially and they updated as the dice were thrown). TIA

0 Kudos
23 Replies
chip645
Beginner
2,585 Views
I see we are both fighting the same battle...

I have found no way to overcome the "horizontal" fixation of "AutoSetProperty" which is irksome 'cause "range" (which is one of the arguments) is supposed to be a freakin' "object" right? Grrrr!

Hopefully, somebody will jump in here and set us both straight. What I did get to work was to build an array of two-cell horizontal ranges which I used to load XY pairs. Here's the code that does that. It's ugly, but it works! (Again, I'm hoping somebody will jump in with a better way- like using the "transpose" function.)


CALL VariantInit(vBSTR1)
vBSTR1%VT = VT_BSTR
CALL VariantInit(vBSTR2)
vBSTR2%VT = VT_BSTR
DO i=1,12
IF (i < 10) THEN
write (Xi,"(A1,I1)")"A",i
write (Yi,"(A1,I1)")"B",i
ELSE IF (i < 100 ) then
write (Xi,"(A1,I2)")"A",i
write (Yi,"(A1,I2)")"B",i
ELSE IF (i < 1000 ) then
write (Xi,"(A1,I3)")"A",i
write (Yi,"(A1,I3)")"B",i
ELSE
write (Xi,"(A1,I4)")"A",i
write (Yi,"(A1,I4)")"B",i
END IF
bstr1 = ConvertStringToBSTR(Xi)
vBSTR1%VU%PTR_VAL = bstr1
bstr2 = ConvertStringToBSTR(Yi)
vBSTR2%VU%PTR_VAL = bstr2
cells(i) = $Worksheet_GetRange(worksheet, vBSTR1, vBSTR2, status)
CALL Check_Status(status, " Unable to get CELL-RANGE object")
cellCounts(i)=0
END DO
Xi="A1"
Yi="B12"
bstr1 = ConvertStringToBSTR(Xi)
vBSTR1%VU%PTR_VAL = bstr1
bstr2 = ConvertStringToBSTR(Yi)
vBSTR2%VU%PTR_VAL = bstr2
range = $Worksheet_GetRange(worksheet, vBSTR1, vBSTR2, status)
CALL Check_Status(status, " Unable to get RANGE object")
status = VariantClear(vBSTR1)
bstr1 = 0
status = VariantClear(vBSTR2)
bstr2 = 0

!status = AUTOSETPROPERTY (range, "VALUE", cellCounts)
! CALL Range_Select(range, status)
$RETURN = Range_Select(range, status) !Range_Select became a function in XL2000!
charts = $Workbook_GetCharts(workbook, $STATUS = status)

Note that there is already (apparently vestigial) code that references the "cells(i)" array in the sample code- but it does nothing- In fact there is one spurious initialization that you have to remove to make it work for columns...

Here's where I actually load the XY pairs:
DO j=1,12
XY(1)=float(j)
XY(2)=float(cellCounts(j))
status = AUTOSETPROPERTY (cells(j), "VALUE", XY)
CALL Check_Status(status, " Unable to set RANGE value")
END DO

I don't know how this is going to perform when I get to the 1000-point columns that I'm contemplating...

Oh, and there is another optional argument ("PlotBy") to chartwizard that you have to set to tell it to plot by columns...

0 Kudos
isn-removed200637
2,585 Views
Chip,
Many thanks for taking the trouble to help.
By being given Autodice as a route in to tackling the problem of 'remote controlling' Excel (or any object) using Fortran calls, I feel like a codebeaker who has been given a small 'crib' (autodice) to an enormous piece of code
(all the methods and properties available for an EXCEL 'object') from which you have to deduce all the
possible values available for the arguments and what they
'do' to the object. For example, how do you find out what 'values' enumerators like XLVALUE or XLCATEGORY can have and what happens for each value? Not a job I feel like pursuing much further at present, given my miserable failure to take even the apparently trivial step forward of getting the numbers into a column of cells instead of into a row. A pointer to a resource that would clarify the whole thing would be appreciated, from anyone out there. Thanks again. Still no word from CVF support....
0 Kudos
Intel_C_Intel
Employee
2,585 Views
Tony, Chip,

I'm afraid you guys have picked a very tough place to start learning about OLE/Automation. FORTRAN is pretty horrible for this. What I do, and if I may suggest you do too, is to write the automation code in something easy (like VB / VBA), just to iron out the syntax, number of arguments etc. etc. then replicate it in FORTRAN. (Remembering that your can't do extended object referencing in FORTRAN which is a pain - i.e. VB object1.object2.property1 turns into FORTRAN as something like:
Get object1.
Set object2 = Object1.GetObject2()
property1 = object2.GetProperty1() )
I have also found in certain cases that automating from FORTRAN just doesn't work. Now that may have been down to the particular COM object I was trying to interface to, or it may have been the FORTRAN - I din't have time to get to the bottom of it.
If you can avoid automation using FORTRAN I'd recommend you do so until it's a little more user friendly.
0 Kudos
isn-removed200637
2,585 Views
You are undoubtedly correct and I intend to start using Visual Basic and Visual C++, since they are obviously
suited to programming with objects/classes whereas Fortran is not. I guess Autodice and other similar examples are useful in that they expose to view the full horror awaiting those attempting OLE and automation from Fortran. regards.
0 Kudos
canaimasoft
Beginner
2,585 Views
You might want to take a look at the f90VB User Manuals (http://www.canaimasoft.com/f90VB/OnlineManuals/Default.htm) as well as some of the examples in our site (http://www.canaimasoft.com/f90VB/Examples/Examples.htm). The manual has a good introduction to COM/ActiveX with detailed explanations on the data types and how to use the from Fortran. Many people have found the information in the manuals useful, even if they are not using our product.

One of the examples in the site is more or less similar to autodice, although it does not use safe arrays to set spreadsheet values. I have attached an example that reads and sets cells using safe arrays, so if you want them let me know and I'll e-mail them to you. You should be able to map most f90VB calls to equivalent sets of calls using the CVF/IVF COM libraries, so they might be useful. The code does use extended refenceing of objects and properties (since f90VB allows this with some limitations), but it is just a matter of de-referencing as judd explained.

Hope this helps.

regards,

Marco A. Garcia
Canaima Software
e-mail:mgarcia@canaimasoft.com
http://www.canaimasoft.com
Developers of f90SQL the Database Connectivity Solution for Fortran, and f90VB the Library for Fortran-OLE Automation and Fortran-VB Programming

0 Kudos
selahattin
Beginner
2,585 Views
Hi Guys,
I think we-you, Chip645 and me - are fighting the same battle, Excel automation.
I have no problem to read/write data to/from any cell or range including columns of active sheet of Excel.
There are a point to pay attention here :
Range size defined VBSTRs must be same with size of one-dimensioned array given at the autosetproperty command. If not ( i.e. less or more), program returns zero values.
As you see above, I can use active sheet only. My problem is to select different sheet from Fortran code.
Do you have any experience about it?
0 Kudos
chip645
Beginner
2,585 Views
Odd that we find different aspects of this problem challenging. I wasn't interested in multiple sheets- but repeated calls to chartwizard gave them to me for free.

I assume you are calling:
INTEGER*4 FUNCTION Worksheets_Add($OBJECT, Before, After, Count, Type, $STATUS)

...and the issue is how to access individual sheets thereafter. I haven't fooled with it, but I found through the school of hard knocks that a call to:

$Worksheet_Activate(worksheet, $STATUS =status)

is required to bring a sheet to the top after you've been off messing with a chart; Otherwise, a call to "Range_Select(range, status)" fails...

That said, I dearly wish someone would post a code fragment that loads values into a spreadsheet column.

To make it work at all I had to load (x,y) pairs one row at a time. To make it perform I had to load my data into long rows and use the "transpose" spreadsheet function to populate the columns.
0 Kudos
selahattin
Beginner
2,585 Views
Hi Chip645,
Thanks for your reply, but unfortunately I couldn't success it.
Before , After arguments at the WorkSheets_Add function are TYPE ( VARIANT). The name of my Worksheet to be selected and activated is "NETW" ( it is character type).
I don't know how I convert it.
For second function- Worksheet_Activate(worksheet, status), I want to define Worksheet= "NETW", but I don't know how I can do it.
Could you write me a code fragment for my sheet selection problem?
For your problem;
please give me Dimension of your matris(x,y) and where you are writing this matris?(i.e. address of cells(i,j) )
I will try to write a code fragment for you?
If you put your email address, I can send directly.
0 Kudos
vinuka
Beginner
2,585 Views
Hi!
Im facing some problems with this interfaces between Fortran and Excel.
What I want is to load a dialog with some buttons and a Spreadsheet (wich is actuallyfound in the ActiveX control insertion list (Microsoft Office Spreadsheet 11.0)). The dialog part is ok!
In this Spreadsheet I want to write some data (any value at any cell, for example).
But ive already seen this autodice code and just cant make my own code.
I dont know if the spreadsheet is already initialized when I run the program and I cant find which functions or subroutines I use to attribute some value to a cell.
I think what I said is confuse, but any help would be gorgeous!
Someone above said that r/w isnt a problem at all...
Hope you can help me!
Thanks!
0 Kudos
Paul_Curtis
Valued Contributor I
2,585 Views
Here's how I do it (see att. code).
This is based on the CVF Excel97A module, and incorporates several utility routines; note that including Excel97A entirely adds 20 minutes to IVF build times, so it's best to only extract the routines actually being used.
0 Kudos
vinuka
Beginner
2,585 Views
Thanks for the answer!
But I couldnt open the file... its empty.
Could you send it to my email?
Or just postthe code in .txt?
Thank you again!
0 Kudos
Paul_Curtis
Valued Contributor I
2,585 Views
This was present in my post yesterday as an attachment, which has since vanished. Here is the code again, this time as a direct text insertion:
    !==== Module initialiations & variables
	    USE IFWINTY
	    USE IFAUTO
	    USE IFCOM

	    ! Variables
	    INTEGER*4 status

	    ! Object Pointers
	    INTEGER*4 excelapp
	    INTEGER*4 workbooks
	    INTEGER*4 workbook
	    INTEGER*4 worksheet


    !==== Sample Excel initialization code ========
    !   res is an error return (set to 0 on success)

		CALL COMINITIALIZE (status)

		! Initialize object pointers
		excelapp	= 0
		workbooks	= 0
		workbook	= 0
		worksheet	= 0

		! Create an Excel object
		res = 1
		CALL COMCREATEOBJECT ("Excel.Application", excelapp, status)
		IF (excelapp == 0) RETURN
		CALL $Application_SetVisible (excelapp, .TRUE.)
		CALL $Application_SetScreenUpdating (excelapp, .FALSE.)

		!	get its window handle
		hwnd_ChildProcess = GetForegroundWindow ()

		! Get the WORKBOOKS object
		res = 2
		workbooks = $Application_GetWorkbooks (excelapp, $STATUS = status)
		IF (status /= 0) RETURN

		! Open a new spreadsheet from the template file
		res = 3
   		workbook = Workbooks_Open (workbooks, tbuf, $STATUS = status)
		IF (status /= 0) RETURN

		! Get the worksheet
		res = 4
		worksheet = $Workbook_GetActiveSheet (workbook, status)
		IF (status /= 0) RETURN

	    ! code goes here to populate cells, prepare the worksheet;
	    ! see utility routines below
	
		CALL $Application_SetScreenUpdating (excelapp, .TRUE.)

    !======= When we are done...

		!   release all objects which may have been created
		IF (worksheet  /= 0) status = COMRELEASEOBJECT (worksheet)
		IF (workbook   /= 0) status = COMRELEASEOBJECT (workbook )
		IF (workbooks  /= 0) status = COMRELEASEOBJECT (workbooks)
		IF (excelapp   /= 0) status = COMRELEASEOBJECT (excelapp )

		CALL COMUNINITIALIZE()



    !================






	SUBROUTINE PutRealInCell (column, row, argval)
		IMPLICIT NONE
		CHARACTER(LEN=*), INTENT(IN)	:: column
		INTEGER, INTENT(IN)				:: row
		REAL, INTENT(IN)				:: argval
		INTEGER							:: range

		range = column_range (column, row)

		status = AUTOSETPROPERTYREAL4 (range, "VALUE", argval)
		
	END SUBROUTINE PutRealInCell


	SUBROUTINE PutTextInCell (column, row, string, width)
		IMPLICIT NONE
		CHARACTER(LEN=*), INTENT(IN)	:: column
		INTEGER, INTENT(IN)				:: row
		CHARACTER(LEN=*), INTENT(INOUT)	:: string
		INTEGER, INTENT(IN), OPTIONAL	:: width
		INTEGER							:: range

		range = column_range (column, row)

		IF (PRESENT(width))	&
			status = AUTOSETPROPERTYINTEGER2 (range, "ColumnWidth", width)

		CALL NullTerminateString (string)
		status = AUTOSETPROPERTYCHARACTER (range, "VALUE", string)

	END SUBROUTINE PutTextInCell


	INTEGER FUNCTION column_range (column, row1, row2) RESULT (range)
		IMPLICIT NONE
		CHARACTER(LEN=*), INTENT(IN)		:: column
		INTEGER, INTENT(IN)					:: row1
		INTEGER, INTENT(IN), OPTIONAL		:: row2
		CHARACTER(LEN=12)					:: cell_id
		TYPE(VARIANT)						:: vBSTR1, vBSTR2
		INTEGER*4							:: pBSTR1, pBSTR2

		WRITE (cell_id, '(A,I6,A)') column, row1, CHAR(0)
		pBSTR1 = leftpack (cell_id)
		

		CALL VariantInit (vBSTR1)
		vBSTR1%VT = VT_BSTR
		pBSTR1 = StringToBSTR (cell_id)
		vBSTR1%VU%PTR_VAL = pBSTR1

		IF (PRESENT(row2)) THEN
			WRITE (cell_id, '(A,I6,A)') column, row1, CHAR(0)
			pBSTR2 = leftpack (cell_id)
			CALL VariantInit (vBSTR2)
			vBSTR2%VT = VT_BSTR
			pBSTR2 = StringToBSTR (cell_id)
			vBSTR2%VU%PTR_VAL = pBSTR2
			range = $Worksheet_GetRange (worksheet, vBSTR1, vBSTR2, $STATUS=status)
			status = VariantClear(vBSTR2)
			IF (pBSTR2 /= 0) CALL SysFreeString (pBSTR2)
		
		ELSE
			range = $Worksheet_GetRange (worksheet, vBSTR1, $STATUS=status)

		END IF
		status = VariantClear(vBSTR1)
		IF (pBSTR1 /= 0) CALL SysFreeString (pBSTR1)
	END FUNCTION column_range
	
0 Kudos
vinuka
Beginner
2,585 Views
Hi Paul-Curtis!
Unfortunatelytheapplication im building doesnt open an Excel Application in an outside window... it creates an ActiveXControl inside its own...
I dont know if youre able to do that, but id really enjoy any help (further than what youve already done! thanks!)
if the attachment doesnt open i can send it to you... it shows the resource im trying to control...
0 Kudos
jdchambless
Beginner
2,585 Views
Hi Paul-Curtis,
If you are still keeping up with this thread, I was hoping you could answer a question for me. I attempted to put your PutRealInCell and column_range functions into my project, but got errors saying that leftpack() and StringToBSTR() were unrecognized. Any help would be appreciated.
Thanks,
Jason C.
0 Kudos
Paul_Curtis
Valued Contributor I
2,585 Views
There seems to be lots of confusion about how to use Excel from F90; it really is fairly easy. Some other poster very recently suggested using VB/C++, and I would urge F90 programmers to treat that as nonsense born of ignorance and laziness -- F90 is a wonderful platform for ANY Win32 programming, it just needs a little "tweaking" to get the interface juju right.

To make things clearer, take a look at the ExcelShell routine below. There is some amount of local context (which does not need detailed explanation for this example, but should be fairly obvious); the routine takes the real (x,y) values from one or more dataset UDT objects and creates a spreadsheet with columns (x, y1, y2, y3 ...) and fills one row of values per point through the extent of the dataset. In addition, the X values might be real numbers, or timestamp values which are rendered in text. This routine is used for datasets with thousands of points, making very large spreadsheets, and works perfectly and quickly.

Most of my F90-Excel "toolkit" functions have been posted several times; a few utility routines are reposted here as requested. I would be glad to continue this discussion as interest may warrant, either here or offline (pcurtis kiltel com). HTH


INTEGER FUNCTION ExcelShell (pltype_thisplot) RESULT (res)
USE ResWrap
IMPLICIT NONE
INTEGER, INTENT(IN) :: pltype_thisplot
INTEGER :: rval
TYPE(timestamp) :: ts
TYPE(dataset),POINTER :: ds
INTEGER :: jtrend, j1, j2, jcol, jrow, npts, width
INTEGER :: pb_unit, pb_count
REAL :: xx, xincr, yy, x1, x2, y1, y2, denom
CHARACTER(len=40) :: tbuf

! check that the template file exists
res = -1
IF (pltype_thisplot == 0) THEN
CALL concat (RootPath(1), 'new.xls', tbuf)
ELSE
CALL concat (RootPath(1), 'temp.xls', tbuf)
END IF
IF (file_exists(tbuf) <= 0) THEN
j1 = chcnt (tbuf, 40)
rval = MessageBox (ghwndMain, tbuf(1:j1)//' not found'//CHAR(0), &
'Excel Initialization Error'c, &
IOR(MB_OK, MB_ICONEXCLAMATION))
RETURN
END IF

! Create an Excel object
res = 1
CALL COMCREATEOBJECT ("Excel.Application", excelapp, status)
IF (excelapp == 0) RETURN
CALL $Application_SetVisible (excelapp, TRUE2)
CALL $Application_SetScreenUpdating (excelapp, FALSE2)

! get its window handle
hwnd_ChildProcess = GetForegroundWindow ()

! Get the WORKBOOKS object
res = 2
workbooks = $Application_GetWorkbooks (excelapp, $STATUS = status)
IF (status /= 0) RETURN

! Open a new spreadsheet from the template file
res = 3
workbook = Workbooks_Open (workbooks, tbuf, $STATUS = status)
IF (status /= 0) RETURN

! Get the worksheet
res = 4
worksheet = $Workbook_GetActiveSheet (workbook, status)
IF (status /= 0) RETURN
IF (pltype_thisplot == 0) GO TO 10

! x-values column header
IF (show_xdays) THEN
tbuf = 'time'//CHAR(0)
xincr = 1./FLOAT(pts_per_hr)
ELSE IF (pltype_thisplot == pltype_trendplot) THEN
tbuf = 'hours'//CHAR(0)
xincr = 1./FLOAT(pts_per_hr)
ELSE
SELECT CASE (distUnits)
CASE (SYSDEF_FEET)
tbuf = STGet(IDS_FEET, 10)
xincr = .5
CASE (SYSDEF_METERS)
tbuf = STGet(IDS_METERS, 10)
xincr = .25
END SELECT
END IF
CALL PutTextInCell ('A',1,tbuf, 14)

! adjust the x increment, if necessary, to trim the point count
npts = (pbxmax - pbxmin)/xincr
DO WHILE (npts > max_datapts)
xincr = xincr + xincr
npts = (pbxmax - pbxmin)/xincr
END DO

! y-values column headers; make all columns the same width as the widest
width = 12
DO jtrend = 1, max_trends
ds => tr(jtrend)
IF (ds%h_textwindow /= DS_LOAD_NOW) CYCLE
& nbsp; width = MAX0(width, chcnt(ds%name, ds_namelength))
END DO
jcol = 0
DO jtrend = 1, max_trends
ds => tr(jtrend)
IF (ds%h_textwindow /= DS_LOAD_NOW) CYCLE
jcol = jcol + 1
CALL PutTextInCell (CHAR(ICHAR('A') + jcol), 1, ds%name, width)
END DO

! y-values data
xx = pbxmin
jrow = 2
byposition: DO WHILE (xx <= pbxmax)
jrow = jrow + 1
CALL x_string (xx, tstart, tbuf)
CALL PutTextInCell ('A', jrow, tbuf)

! y values for all datasets, interpolated as necessary to
! match a uniform set of x-values over the x interval
jcol = 0
bytrend: DO jtrend = 1, max_trends
ds => tr(jtrend)
IF (ds%h_textwindow /= DS_LOAD_NOW) CYCLE
jcol = jcol + 1

DO j1 = 1, ds%npts - 1
x1 = ds%x(j1)
IF (x1 > xx) EXIT
j2 = j1 + 1
x2 = ds%x(j2)
IF (x1 < xx .AND. xx <= x2) THEN
y1 = ds%y(j1)
IF (y1 == unmeasured) CYCLE
y2 = ds%y(j2)
IF (y2 == unmeasured) CYCLE
denom = x2 - x1
IF (denom < 1.E-3) THEN
yy = 0.5*(y1 + y2)
ELSE
yy = y1 + (y2 - y1)*(xx - x1)/(x2 - x1)
END IF
  ; CALL PutRealInCell (CHAR(ICHAR('A') + jcol), jrow, yy)
EXIT
END IF
CALL delay_ms (0)
END DO

END DO bytrend

xx = xx + xincr
END DO byposition

10 CALL $Application_SetScreenUpdating (excelapp, TRUE2)

! make the child process system-modal with respect to mouse events;
! this will also prevent the Excel window from being minimized (see commkrnl)
CALL Mousehook (hwnd_ChildProcess)
res = 0

END FUNCTION ExcelShell




RECURSIVE FUNCTION leftpack (text) RESULT (nc)
IMPLICIT NONE
CHARACTER(LEN=*),INTENT(INOUT) :: text
INTEGER :: j, nc
CHARACTER(LEN=1),PARAMETER :: blank = ' '

text = ADJUSTL(text)
nc = LEN(text)
DO j = 1, nc-1
IF (text(j:j) == blank) text(j:nc) = & ADJUSTL(text(j:nc))
END DO
nc = chcnt (text, LEN(text))
END FUNCTION leftpack

RECURSIVE FUNCTION chcnt (text, ncmax) RESULT (nc)
IMPLICIT NONE
CHARACTER(LEN=*),INTENT(IN) :: text
INTEGER,INTENT(IN) :: ncmax
INTEGER :: nc
DO nc = MIN0(LEN(text),ncmax),1,-1
IF (ICHAR(text(nc:nc)) > 32) RETURN
END DO
nc = 0
END FUNCTION chcnt

! this routine is copied from Excel97a.f90, and
! renamed from ConvertStringToBstr(), which has a linker conflict
INTEGER(INT_PTR_KIND()) FUNCTION StringToBSTR(string)
USE OLEAUT32
USE IFNLS
CHARACTER*(*), INTENT(IN) :: string
INTEGER(INT_PTR_KIND()) bstr
INTEGER*4 length
INTEGER*2, ALLOCATABLE :: unistr(:)
! First call to MBConvertMBToUnicode determines the length to allocate
ALLOCATE (unistr(0))
length = MBConvertMBToUnicode(string, unistr)
DEALLOCATE (unistr )
! Special case for all spaces
IF (length < 0) THEN
ALLOCATE (unistr(2))
unistr(1) = #20 ! Single space
unistr(2) = 0 ! Null terminate
ELSE
! Second call to MBConvertMBToUnicode does the conversion
ALLOCATE (unistr(length+1))
length = MBConvertMBToUnicode(string, unistr)
unistr(length+1) = 0 ! Null terminate
END IF
bstr = SysAllocString(unistr)
DEALLOCATE (unistr)
StringToBSTR = bstr
END FUNCTION StringToBSTR



0 Kudos
jdchambless
Beginner
2,585 Views

Thank you for the routines, Paul. I have a quick question for anyone interested, about the AUTOSETPROPERTY function:

The Intel help page for this function states that the value argument must be, at most, a single dimension array of a certain set of types. What function can be used if you would like to write a 2D array (100 by 8 in my case) into a certain range of cells in excel?

Thanks,
Jason C.

0 Kudos
anthonyrichards
New Contributor III
2,585 Views

I have tried , using Paul Curtis's code (many thanks BTW) to write a column of values using

SUBROUTINE PutRealsInCells (column, row1, row2, argval)
USE dfAUTO
USE dfCOM
use dfwin
USE EXCELINT ! contains interfaces for the main routines
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: column
INTEGER, INTENT(IN) :: row1, row2
REAL, INTENT(IN) :: argval(row2-row1+1)
INTEGER :: range, status

range = column_range (column, row1, row2)! Ihad to edit the 'column_range' code to actually use the row2 value
status = AUTOSETPROPERTYREAL4ARRAY (range, "VALUE", ARGVAL, VT_R4)

END SUBROUTINE PutRealsInCells

But EXCEL stubbornly persists inputting the first value stored in the 1-D array into all the rows in the specified column.
It may work for a range consisting of only a row, in which case you will have to call the routine to set your row of 8 values 100 times....Failing that, you will have to do it one cell at a time!

By the way, It appears that F90VB from CanaimaSoft will do all you need to do to drive EXCEL from FORTRAN...unfortunately it may be difficult to get hold of it now, since the compnay is having some difficulty surviving I believe...see http://www.canaimasoft.com/f90VB/Index.htm.

How about Intel 'rescuing it' from Canaima and putting it out with IVF, Steve?

0 Kudos
Steven_L_Intel1
Employee
2,585 Views
f90VB is basically a substitute for the Module Wizard, and Marco Garcia (Canaima) is off doing other things. I got permission from him to distribute f90SQL (which is useful), but didn't discuss f90VB.
0 Kudos
Paul_Curtis
Valued Contributor I
2,585 Views
Sorry for the confusion Anthony, but the PutRealInCell () routine is intended only to put a single real value into whatever cells are specified by the range argument.

I am not aware of any automatic means of associating the sequential elements of a Fortran real array with a corresponding sequence of rows in the same column (that is, there may be such a function, but I have not written it, used it, nor spent any time looking for it). My codes often pump large arrays into spreadsheets, but I do it one cell at a time within a loop, using PutRealInCell, which works very well.

A recent post in one of these Excel threads mentioned a new (to me, anyway) product which may address some of these issues:

http://www.qtsoftware.de/vertrieb/db/qtxls_e.htm
0 Kudos
anthonyrichards
New Contributor III
2,433 Views

Hey Paul, I'm not complaining about your code, which is fine by me,it's EXCEL that is not acting conveniently. By the way, I have found that modifying the range parameter to define a row of cells and modifying one of your routines (see 'PutRealsInCols' below)and one of your functions (see 'row_range' below)allows an array of values to be added to a row. However, this means getting into mod(26) arithmetic to translate a row length starting at a particular cell into the appropriate column labels (for example, 100 cells in row 3 starting at column D requires specifying the first column character as 'D' and the second column indicator as 'CY' , which has to be generated after doing sums involving 100(mod 26) etc. which, although do-able, is a pain). I have also tried changing the cell reference to R1C1 ( using

! XlReferenceStyle
INTEGER, PARAMETER ::xlA1 = 1
INTEGER, PARAMETER ::xlR1C1 = -4150
CALL $Application_SetReferenceStyle (excelapp, XLR1C1, $STATUS = status)

which works), and havegenerated a cell range in R1C1 format and used it instead of the A1 format range, but EXCEL doesn't just ignore such a range parameter, it re-uses the A1 formatted range value used in a previous call, returning a status=0 indicating success!.

For what it is worth to anyone looking in, here is the code I generated to add an array of values to a row of cells referenced using the A1..AZ, AA..ZZscheme...

integer i, ntimes, status
real(4) times(100)
ntimes=100
do i=1,ntimes
times(i)=i
enddo
CALL PutRealsInCols (2,'D', 'CY', TIMES, ntimes, status)
...
SUBROUTINE PutRealsInCols (row, col1, col2, argval, nval, status)
USE dfAUTO
USE dfCOM
use dfwin
USE EXCELINT ! contains interfaces for main functions
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: col1
CHARACTER(LEN=*), INTENT(IN) :: col2
INTEGER, INTENT(IN) :: row, nval
REAL, INTENT(IN) :: argval(nval)
INTEGER :: range, status
range = row_range (row, col1, col2)
status = AUTOSETPROPERTYREAL4ARRAY (range, "VALUE", ARGVAL, VT_R4)
END SUBROUTINE PutRealsInCols
INTEGER FUNCTION row_range (row, col1, col2) RESULT (range)
USE dfAUTO
USE dfCOM
USE EXCELINT ! contains interfaces for main functions
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: col1
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: col2
INTEGER(INT_PTR_KIND()) StringToBSTR
INTEGER, INTENT(IN) :: row
CHARACTER(LEN=12) :: cell_id
TYPE(VARIANT) :: vBSTR1, vBSTR2
INTEGER*4 :: pBSTR1, pBSTR2, status
WRITE (cell_id, '(A2,I6,A)') col1, row, CHAR(0)
pBSTR1 = leftpack (cell_id)
CALL VariantInit (vBSTR1)
vBSTR1%VT = VT_BSTR
pBSTR1 = StringToBSTR (cell_id)
vBSTR1%VU%PTR_VAL = pBSTR1
IF (PRESENT(col2)) THEN
WRITE (cell_id, '(A2,I6,A)') col2, row, CHAR(0)
pBSTR2 = leftpack (cell_id)
CALL VariantInit (vBSTR2)
vBSTR2%VT = VT_BSTR
pBSTR2 = StringToBSTR (cell_id)
vBSTR2%VU%PTR_VAL = pBSTR2
range = $Worksheet_GetRange (worksheet, vBSTR1, vBSTR2, $STATUS=STATUS)
status = VariantClear(vBSTR2)
IF (pBSTR2 /= 0) CALL SysFreeString (pBSTR2)
ELSE
range = $Worksheet_GetRange (worksheet, vBSTR1, $STATUS=STATUS)END IF

status = VariantClear(vBSTR1)
IF (pBSTR1 /= 0) CALL SysFreeString (pBSTR1)
END FUNCTION row_range

0 Kudos
Reply