excel.lisp (5695B)
1 ;;; CLisp OLE Automation interface 2 ;;; 3 ;;; Copyright (C) 2005 Tomas Hlavaty <kvietaag@seznam.cz> 4 ;;; 5 ;;; This is Free Software, covered by the GNU GPL (v2) 6 ;;; See http://www.gnu.org/copyleft/gpl.html 7 8 (defpackage "EXCEL" 9 (:use "OLE" "LISP") 10 (:export "EXCEL" "WORKBOOKS" "WORKBOOK" "WORKSHEETS" "WORKSHEET" "RANGE")) 11 12 (in-package "EXCEL") 13 14 (pushnew :excel *features*) 15 16 ;;; classes 17 18 (defclass excel (idispatch) 19 () 20 (:default-initargs :interface (ole:create "excel.application" t))) 21 22 (defclass workbooks (idispatch) 23 ()) 24 25 (defclass workbook (idispatch) 26 ()) 27 28 (defclass worksheets (idispatch) 29 ()) 30 31 (defclass worksheet (idispatch) 32 ()) 33 34 (defclass range (idispatch) 35 ()) 36 37 ;;; methods 38 39 (defmethod quit-excel ((excel excel)) 40 (ole:invoke-method excel "quit")) 41 42 (defmethod excel-version ((excel excel)) 43 (ole:invoke-get excel "version")) 44 45 (defmethod visible ((excel excel)) 46 (ole:invoke-get excel "visible")) 47 48 (defmethod (setf visible) (visible (excel excel)) 49 (ole:invoke-put excel "visible" (if visible 1 0)) 50 visible) 51 52 ;;(with-ole ((excel (make-instance 'excel))) 53 ;; (setf (visible excel) t) 54 ;; (format t "@@@ *ole-objects* ~s~%" ole::*ole-objects*)) 55 56 ;; (with-ole () 57 ;; (with-iunknown (excel (make-instance 'excel :interface (create "excel.application" t))) 58 ;; (format t "-- visible ~s~%" (visible excel)) 59 ;; (format t "-- visible ~s~%" (setf (visible excel) t)) 60 ;; (format t "-- visible ~s~%" (visible excel)) 61 ;; (format t "-- visible ~s~%" (setf (visible excel) nil)) 62 ;; (format t "-- visible ~s~%" (visible excel)))) 63 64 (defmethod user-control ((excel excel)) 65 (ole:invoke-get excel "usercontrol")) 66 67 (defmethod active-book ((excel excel)) 68 (let ((dispatch (ole:invoke excel ole::DISPATCH_PROPERTYGET "activebook" nil t))) 69 (when dispatch 70 (make-instance 'workbook :interface dispatch)))) 71 72 (defmethod active-sheet ((excel excel)) 73 (let ((dispatch (ole:invoke excel ole::DISPATCH_PROPERTYGET "activesheet" nil t))) 74 (when dispatch 75 (make-instance 'worksheet :interface dispatch)))) 76 77 ;(defmethod active-cell ((excel excel)) 78 ; (ole:invoke-get excel "activecell")) 79 80 (defmethod open-excel-file ((self workbooks) filename) 81 (ole:invoke-get self "open" filename)) 82 83 (defmethod add-workbook ((books workbooks) &optional name) 84 (let ((dispatch (if name 85 (ole:invoke books ole::DISPATCH_PROPERTYGET "add" (list name) t) 86 (ole:invoke books ole::DISPATCH_PROPERTYGET "add" nil t)))) 87 (when dispatch 88 (make-instance 'workbook :interface dispatch)))) 89 90 (defmethod add-worksheet ((book workbook) &optional name) 91 (let ((dispatch (if name 92 (ole:invoke book ole::DISPATCH_PROPERTYGET "add" (list name) t) 93 (ole:invoke book ole::DISPATCH_PROPERTYGET "add" nil t)))) 94 (when dispatch 95 (make-instance 'worksheet :interface dispatch)))) 96 97 (defmethod count-workbooks ((self workbooks)) 98 (ole:invoke-get self "count")) 99 100 (defmethod count-worksheets ((self worksheets)) 101 (ole:invoke-get self "count")) 102 103 (defmethod name ((self workbook)) 104 (ole:invoke-get self "name")) 105 106 (defmethod name ((self worksheet)) 107 (ole:invoke-get self "name")) 108 109 (defmethod workbooks ((self excel)) 110 (let ((dispatch (ole:invoke self ole::DISPATCH_PROPERTYGET "workbooks" nil t))) 111 (when dispatch 112 (make-instance 'workbooks :interface dispatch)))) 113 114 (defmethod workbook ((self excel) i) 115 (let ((dispatch (ole:invoke self ole::DISPATCH_PROPERTYGET "workbooks" 116 (list i) t))) 117 (when dispatch 118 (make-instance 'workbook :interface dispatch)))) 119 120 (defmethod worksheets ((self workbook)) 121 (let ((dispatch (ole:invoke self ole::DISPATCH_PROPERTYGET "worksheets" nil t))) 122 (when dispatch 123 (make-instance 'worksheets :interface dispatch)))) 124 125 (defmethod worksheet ((self workbook) i) 126 (let ((dispatch (ole:invoke self ole::DISPATCH_PROPERTYGET "worksheets" 127 (list i) t))) 128 (when dispatch 129 (make-instance 'worksheet :interface dispatch)))) 130 131 (defmethod range ((sheet worksheet) &optional name) 132 (let ((dispatch (if name 133 (ole:invoke sheet ole::DISPATCH_PROPERTYGET "range" (list name) t) 134 (ole:invoke sheet ole::DISPATCH_PROPERTYGET "range" nil t)))) 135 (when dispatch 136 (make-instance 'range :interface dispatch)))) 137 138 (defmethod (setf value) (val (range range)) 139 (ole:invoke-put range "value" val) 140 val) 141 142 (defmethod (setf saved) (val (book workbook)) 143 (ole:invoke-put book "saved" (if val 1 0)) 144 val) 145 146 ;;; examples 147 148 (defun get-structure (filename) 149 (ole:with-ole ((excel (make-instance 'excel)) 150 (books (workbooks excel))) 151 (open-excel-file books filename) 152 (prog1 (loop for i from 1 to (count-workbooks books) 153 for book = (workbook excel i) 154 for sheets = (worksheets book) 155 collect (cons (name book) 156 (list 157 (loop for i from 1 to (count-worksheets sheets) 158 for sheet = (worksheet book i) 159 collect (name sheet))))) 160 (quit-excel excel)))) 161 162 ;;(get-structure "c:/Program Files/Microsoft Office/OFFICE11/SAMPLES/SOLVSAMP.XLS") 163 164 (defun example1 () 165 (ole:with-ole ((excel (make-instance 'excel)) 166 (books (workbooks excel))) 167 (setf (visible excel) t) 168 (let* ((book (add-workbook books)) 169 (sheet (active-sheet excel)) 170 (range (range sheet "A1:E7"))) ; intentionally isn't 3x3 array;-) 171 (prog1 (list (name book) (name sheet)) 172 (let* ((n 3) ; 3x3 array:-) 173 (data (make-array `(,n ,n)))) 174 (dotimes (i n) 175 (dotimes (j n) 176 (setf (aref data i j) (* (1+ i) (1+ j))))) 177 (setf (value range) data)) 178 (sleep 3) ; watch the sheet for a while 179 (setf (saved book) t) 180 (quit-excel excel))))) 181 182 ;;(example1)