Communicating With Microsoft Excel from Revolution |
|
Sure! Here you go...
Mac Approach
Here's the way to do it for Mac. The basic script for AppleScript is like this:
To translate this to Revolution, you'd do this (I use a q() function for quoting data that makes it easier to work with):tell application "Microsoft Excel" set value of cell "B3" to 500 end tell
Windows Approachon mouseUp SendToXL "500","B3" end mouseUp on SendToXL pWhat,pCell put "tell app" && q("Microsoft Excel") & cr & \ "set value of cell" && q(pCell) && "to" && q(pWhat) & cr & \ "end tell" into tScript do tScript as AppleScript end SendToXL function q pWhat return quote & pWhat & quote end q
Here's the way to do it for Windows. The basic VB Script code looks like this:
To translate this to Revolution, you need to output this to a .vbs file and "run" it, and then delete it when you're done. Here's how:Dim ObjXL Set ObjXL = GetObject(,"Excel.Appliction") ObjXL.Range("B3").Value = "500"
If you're developing cross-platform, you can merge them into the same handler by checking "the platform":on mouseUp SendToXL "500","B3" end mouseUp on SendToXL pWhat,pCell put "Dim ObjXL" & cr & \ "Set ObjXL = GetObject(," & q("Excel.Application") & ")" & cr & \ "ObjXL.Range(" & q(pCell) & ").Value =" && q(pWhat) into tScript -- Put the script into a file on disk put "C:\VBSTemp.vbs" into tFile put tScript into url("file:" & tFile) -- Run the file set the hideConsoleWindows to true get shell("cscript.exe //nologo" && tFile) -- Now, delete the file; best way is to give it 1 second to complete -- before deleting, so I'll use the "send in
Full Versionon SendToXL pWhat,pCell switch (the platform) case "MacOS" -- put the Mac code here break case "Win32" -- put the Windows code here break end switch end SendToXL
Here's a fully comprehensive version that will get and set both individual cells and ranges (both named and in A1:B1 style) that is cross-platform to boot:
Exampleson SendToXL pWhat,pRangeRef -- assumes tab & cr delimited data set the itemDel to tab switch (the platform) case "MacOS" put "" into tList repeat for each line tLine in pWhat replace quote with numToChar(1) in tLine -- temporary replace tab with (quote & "," & quote) in tLine put quote & tLine & quote into tLine replace numToChar(1) with ("\" & quote) in tLine put "{" & tLine & "}" & "," after tList end repeat delete char -1 of tList put "tell app" && q("Microsoft Excel") & cr & \ "set the value of range" && q(pRangeRef) && "to" && "{" & tList & "}" & cr & \ "end tell" into tScript do tScript as AppleScript break case "Win32" put the number of items of line 1 of pWhat into tNumCols put the number of lines of pWhat into tNumRows put "Dim ObjXL,tRetVal,tRow,tCol" & cr & \ "Dim tDataA(" & tNumCols & "," & tNumRows & ")" & cr & \ "Set ObjXL = GetObject(," & q("Excel.Application") & ")" into tScript repeat with x = 1 to tNumCols repeat with y = 1 to tNumRows put tScript & cr & "tDataA(" & x & "," & y & ") = " & q(item x of line y of pWhat) into tScript end repeat end repeat put tScript & cr & "For tRow = 1 To" && tNumRows & cr & \ "For tCol = 1 to" && tNumCols & cr & \ "ObjXL.Range(" & q(pRangeRef) & ").Cells(tRow,tCol).Value = tDataA(tCol,tRow)" & cr & \ "Next" & cr & "Next" into tScript put "C:\VBSTemp.vbs" into tFile put tScript into url("file:" & tFile) set the hideConsoleWindows to true get shell("cscript.exe //nologo" && tFile) send "delete file" && q(tFile) to me in 1 second break end switch end SendToXL function GetFromXL pRangeRef switch (the platform) case "MacOS" put "tell app" && q("Microsoft Excel") & cr & \ "get the value of range" && q(pRangeRef) & cr & \ "end tell" into tScript do tScript as AppleScript put the result into tData replace "{{" with "{" in tData replace "}}" with "}" in tData replace "}, " with ("}" & cr) in tData replace ("\" & quote) with numToChar(1) in tData replace (quote & ", ") with tab in tData if char 1 of tData = "{" then delete char 1 of tData if char -1 of tData = "}" then delete char -1 of tData replace ("}" & cr & "{") with CR in tData replace quote with "" in tData replace numToChar(1) with quote in tData return tData break case "Win32" put "Dim ObjXL,tNumRows,tNumCols,tRetVal,tRow,tCol" & cr & \ "Set ObjXL = GetObject(," & q("Excel.Application") & ")" & cr & \ "tNumRows = ObjXL.Range(" & q(pRangeRef) & ").Rows.Count" & cr & \ "tNumCols = ObjXL.Range(" & q(pRangeRef) & ").Columns.Count" into tScript put tScript & cr & "For tRow = 1 To tNumRows" & cr & \ "For tCol = 1 to tNumCols" & cr & \ "If tCol <> tNumCols Then" & cr & \ "tRetVal = tRetVal & ObjXL.Range(" & q(pRangeRef) & ").Cells(tRow,tCol).Value & vbTab" & cr & \ "Else" & cr & \ "tRetVal = tRetVal & ObjXL.Range(" & q(pRangeRef) & ").Cells(tRow,tCol).Value & vbCrLf" & cr & \ "End If" & cr & "Next" & cr & "Next" into tScript put tScript & cr & "tRetVal = Left(tRetVal,Len(tRetVal) - 2)" & cr & \ "WScript.Echo tRetVal" into tScript put "C:\VBSTemp.vbs" into tFile put tScript into url("file:" & tFile) set the hideConsoleWindows to true get shell("cscript.exe //nologo" && tFile) send "delete file" && q(tFile) to me in 1 second if char -1 of it is CR then delete char -1 of it -- strip any trailing CR return it break end switch end GetFromXL
SendToXL "500","A1" -- specific cell SendToXL "Ken" & tab & "100" & cr & "John" & tab & "500","A1:B2" -- specified range SendToXL "Ken" & tab & "100" & cr & "John" & tab & "500","Scores" -- named range put GetFromXL("A1") --> 500 put GetFromXL("A1:B2") --> Ken 100 John 500 put GetFromXL("Scores") --> Ken 100 John 500
Posted 3/18/2005 by Ken Ray to the Use-Revolution List
Updated 3/3/2006 by Ken Ray to add sending/receiving ranges