Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
xlwrapper.bi
| Uploader: |  OneCypher |
| Datum/Zeit: | 31.03.2009 21:47:54 |
#define UNICODE
#include once "disphelper\disphelper.bi"
#define xlCalculationAutomatic -4105
#define xlCalculationManual -4135
#define xlCalculationSemiautomatic 2
#define xlDone 0
#define xlPending 2
#define xlCalculating 1
'Excel-FB-Wrapper: Ermöglicht eine VBA-Syntax-nahe Programmmierung von Excel-Makros in Freebasic
'Copyright (C) 2008 Christian H.
'This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version.
'This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
'You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>.
'Hilfsmittel:
'Weil man in Freebasic nicht mehr als 1. Index einem Property übergeben kann
'muss man sich vorerst über einen Umweg über eine Funktion die einen UDT zurückgibt behelfen.
'Das ist leider nicht sehr VBA-Nah. Aber sonst schauts bisher mal nicht zu schlecht aus.
'Grundlegende Funktionen zur Datenverarbeitung sind implementiert, wenn auch nicht umfassend.
type _rc
row as integer
column as integer
end type
function rc (r as integer, c as integer) as _rc
dim tmprc as _rc
tmprc.row = r
tmprc.column = c
return tmprc
end function
'Wir fange von oben nach unten mit den "kleinsten" Objekten in Excel-VBA an und arbeiten uns bis zur
'Applikationsebene runter:
'Zellen ... Bereiche ... Blätter ... Mappen ... Excel-Anwendung
'Zellen:
type xlcells
xlcells_id as IDispatch ptr
declare property value() as string
declare property value overload (v as string)
declare property value overload (v as integer)
declare property value overload (v as double)
end type
property xlcells.value() as string
Dim As Zstring Ptr txt = NULL
dhGetValue("%s", @txt, xlcells_id, ".value")
return *txt
end property
property xlcells.value overload (v as string)
dhputvalue(xlcells_id,".Value = %s",v)
end property
property xlcells.value overload (v as integer)
dhputvalue(xlcells_id,".Value = %d",v)
end property
property xlcells.value overload (v as double)
dhputvalue(xlcells_id,".Value = %d", v)
end property
'Bereiche:
type xlrange
xlrange_id as IDispatch ptr
declare property value as string
declare property value overload (v as string)
declare property value overload (v as integer)
declare property value overload (v as double)
declare function cells(rc as _rc) as xlcells
declare property row as integer
declare property column as integer
end type
property xlrange.value as string
Dim As Zstring Ptr txt = NULL
dhGetValue("%s", @txt, xlrange_id, ".value")
return *txt
end property
property xlrange.value overload (v as string)
dhputvalue(xlrange_id,".Value = %s",v)
end property
property xlrange.value overload (v as integer)
dhputvalue(xlrange_id,".Value = %d",v)
end property
property xlrange.value overload (v as double)
dhputvalue(xlrange_id,".Value = %d", v)
end property
property xlrange.row as integer
Dim i As integer
dhGetValue("%d", @i, xlrange_id, ".row")
return i
end property
property xlrange.column as integer
Dim i As integer
dhGetValue("%d", @i, xlrange_id, ".column")
return i
end property
function xlrange.cells(rc as _rc) as xlcells
dim tmpcells as xlcells
dhGetValue("%o", @tmpcells.xlcells_id, xlrange_id, "cells(%d,%d)", rc.row, rc.column )
return tmpcells
end function
'Blatt:
type xlsheet
xlsheet_id As IDispatch Ptr
declare function range(index as string) as xlrange
declare function cells(rc as _rc) as xlcells
declare property name as string
declare property name(v as string)
end type
function xlsheet.range(index as string) as xlrange
dim tmprange as xlrange
dhGetValue("%o", @tmprange.xlrange_id, xlsheet_id, "Range(%s)", index )
return tmprange
end function
function xlsheet.cells(rc as _rc) as xlcells
dim tmpcells as xlcells
dhGetValue("%o", @tmpcells.xlcells_id, xlsheet_id, "cells(%d,%d)", rc.row, rc.column )
return tmpcells
end function
property xlsheet.name as string
Dim As Zstring Ptr txt = NULL
dhGetValue("%s", @txt, xlsheet_id, ".Name")
return *txt
end property
property xlsheet.name (v as string)
dhputvalue(xlsheet_id,".Name = %s",v)
end property
'Blätter:
type xlsheets
xlsheets_id as IDispatch ptr
declare function Count as integer
declare function Add as xlsheet
end type
function xlsheets.add as xlsheet
dim tmpsheet as xlsheet
dhGetValue("%o", @tmpsheet.xlsheet_id, xlsheets_id, "Sheets.Add", "" )
return tmpsheet
end function
function xlsheets.count as integer
dim c as integer
dhGetValue("%d",@c,xlsheets_id,".Count")
Return c
end function
'Arbeitsmappe
type xlworkbook
xlworkbook_id as IDispatch ptr
declare function ActiveSheet() as xlsheet
declare function worksheets overload () as xlsheets
declare function worksheets overload (v as integer) as xlsheet
declare function worksheets overload (v as string) as xlsheet
declare sub close(b as integer)
declare property name as string
end type
function xlworkbook.ActiveSheet() as xlsheet
dim tmpsheet as xlsheet
dhGetValue("%o", @tmpsheet.xlsheet_id, xlworkbook_id, ".activesheet")
return tmpsheet
end function
property xlworkbook.name as string
Dim As Zstring Ptr txt = NULL
dhGetValue("%s", @txt, xlworkbook_id, ".Name")
return *txt
end property
function xlworkbook.worksheets() as xlsheets
dim tmpsheets as xlsheets
dhGetValue("%o", @tmpsheets.xlsheets_id, xlworkbook_id, ".sheets")
return tmpsheets
end function
function xlworkbook.worksheets(v as integer) as xlsheet
dim tmpsheet as xlsheet
dhGetValue("%o", @tmpsheet.xlsheet_id, xlworkbook_id, ".sheets(%d)", v)
return tmpsheet
end function
function xlworkbook.worksheets(v as string) as xlsheet
dim tmpsheet as xlsheet
dhGetValue("%o", @tmpsheet.xlsheet_id, xlworkbook_id, ".sheets(%s)", v)
return tmpsheet
end function
sub xlworkbook.close(b as integer)
dhcallmethod(xlworkbook_id, ".Close %b", b)
end sub
'Arbeitsmappen
type xlworkbooks
xlworkbooks_id as IDispatch ptr
declare function Count as integer
declare function Add as xlworkbook
declare function Open(Filename as string, UpdateLinks as integer = true,_
ReadOnly as integer = false, Format as integer = 5,_
Password as string = "",WriteResPasword as string = "",_
IgnoreReadOnlyRecommended as integer = false,Origin as integer = 2,_
Delimiter as string = "",Editable as integer = false,_
Notify as integer = false, Converter as integer = 0,_
AddToMru as integer = false, xlLocal as integer = false, _
CorruptLoad as integer = 0) as xlworkbook
end type
function xlworkbooks.Count() as integer
dim c as integer
dhGetValue("%d",@c,xlworkbooks_id,".Count")
Return c
end function
function xlworkbooks.Add() as xlworkbook
dim tmpbook as xlworkbook
dhGetValue("%o", @tmpbook.xlworkbook_id, xlworkbooks_id, ".Add", "" )
return tmpbook
end function
function xlworkbooks.Open(Filename as string, UpdateLinks as integer = true,_
ReadOnly as integer = false, Format as integer = 5,_
Password as string = "",WriteResPasword as string = "",_
IgnoreReadOnlyRecommended as integer = false,Origin as integer = 2,_
Delimiter as string = "",Editable as integer = false,_
Notify as integer = false, Converter as integer = 0,_
AddToMru as integer = false, xlLocal as integer = false, _
CorruptLoad as integer = 0) as xlworkbook
'print format
dim tmpbook as xlworkbook
dim parameter as string = ""
parameter = "%s," 'Filename
parameter = parameter & "%b," 'Updatelinks
parameter = parameter & "%b," 'ReadOnly
parameter = parameter & "%d," 'Format
parameter = parameter & "%s," 'Passoword
parameter = parameter & "%s," 'WriteResPassword
parameter = parameter & "%b," 'IgnoreReadOnlyRecommended
parameter = parameter & "%d," 'Origin
parameter = parameter & "%s," 'Delimiter
parameter = parameter & "%b," 'Editable
parameter = parameter & "%b," 'Notify
parameter = parameter & "%d," 'Converter
parameter = parameter & "%b," 'AddToMru
parameter = parameter & "%b," 'local
parameter = parameter & "%d" 'CorruptLoad
dhGetValue("%o", @tmpbook.xlworkbook_id, xlworkbooks_id, ".Open(" & parameter & ")", Filename, UpdateLinks,_
ReadOnly,Format,_
Password ,WriteResPasword,_
IgnoreReadOnlyRecommended, Origin,_
Delimiter, Editable,_
Notify, Converter,_
AddToMru, xlLocal,_
CorruptLoad)
return tmpbook
end function
'Excel-Anwendung
type xlapp
public:
xlApp_id As IDispatch Ptr
declare sub start()
declare sub close()
declare function ActiveWorkbook() as xlworkbook
declare function workbooks overload () as xlworkbooks
declare function workbooks overload (v as integer) as xlworkbook
declare function workbooks overload (v as string) as xlworkbook
declare property SheetsInNewWorkbook() as integer
declare property SheetsInNewWorkbook(n as integer)
declare property visible() as integer
declare property visible(b as integer)
declare property Calculation() as integer
declare property Calculation(c as integer)
declare property CalculationState() as integer
end type
sub xlapp.start()
dhInitialize(TRUE)
dhToggleExceptions(FALSE)
dhCreateObject("Excel.Application", NULL, @xlApp_id)
dhPutValue(xlApp_id, ".Visible = %b", TRUE)
end sub
sub xlapp.close()
dhcallmethod(xlapp_id,"quit")
end sub
function xlapp.ActiveWorkbook() as xlworkbook
dim tmpbook as xlworkbook
dhGetValue("%o", @tmpbook.xlworkbook_id, xlApp_id, "ActiveWorkbook")
return tmpbook
end function
function xlapp.workbooks() as xlworkbooks
dim tmpbooks as xlworkbooks
dhGetValue("%o", @tmpbooks.xlworkbooks_id, xlApp_id, "Workbooks")
return tmpbooks
end function
function xlapp.workbooks(v as integer) as xlworkbook
dim tmpbook as xlworkbook
dhGetValue("%o", @tmpbook.xlworkbook_id, xlApp_id, "Workbooks(%d)", v)
return tmpbook
end function
function xlapp.workbooks(v as string) as xlworkbook
dim tmpbook as xlworkbook
dhGetValue("%o", @tmpbook.xlworkbook_id, xlApp_id, "Workbooks(%s)", v)
return tmpbook
end function
property xlapp.Calculation() as integer
dim c as integer
dhgetvalue("%d", @c, xlapp_id, ".Calculation")
return c
end property
property xlapp.Calculation(c as integer)
dhputvalue(xlapp_id,".Calculation = %d",c)
end property
property xlapp.CalculationState() as integer
dim c as integer
dhgetvalue("%d", @c, xlapp_id, ".CalculationState")
return c
end property
property xlapp.SheetsInNewWorkbook() as integer
dim n as integer
dhgetvalue("%d", @n, xlapp_id, "SheetsInNewWorkbook")
return n
end property
property xlapp.SheetsInNewWorkbook(n as integer)
dhputvalue(xlapp_id,"sheetsinnewworkbook = %d",n)
end property
property xlapp.visible() as integer
dim b as integer
dhgetValue("%b", @b, xlApp_id, ".Visible")
return b
end property
property xlapp.visible(b as integer)
dhputvalue(xlapp_id,".Visible = %b",b)
end property