LISP. LIB. Функция получения данных из Excel

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;функция возвращает указанный прямоугольный диапазон ячеек из екселя в виде
;;;((?строки ?столбца Значение) (?строки ?столбца Значение).....(?строки ?столбца Значение))
;;;Причем верхняя левая ячейка диапазона получает номер 1 1 т.е. (1 1 Значение)
;;;Если ячейка пустая, ее значение = "Empty"
;;;
;;;Вызов (get_excel_range path sheet_name_or_number r1 c1)
;;;где:
;;; path - путь к файлу екселя вида "Disk:\\Dir1\\.....\\DirN\\file.xls"
;;; sheet_name_or_number - имя листа(STRING) или его номер(INT)
;;; r1   - верхняя левая ячейка диапазона. например "A1"
;;; c1   - нижняя правая ячейка диапазона. Например "F15"
;;;
;;;Возможные варианты вызова:
;;; - без указания диапазона
;;;   (get_excel_range path sheet_name_or_number nil nil)
;;;Функция попробует открыть файл по указанному пути и, если удастся открыть, попробует активировать указанный лист
;;;и попросит подсветить диапазон вручную. Если не удастся - попросит открыть файл и подсветить диапазон вручную.
;;;если листа с заданным именем(номером) не существует - вылет с ошибкой Automation error
;;; - без указания имени листа и диапазона
;;;   (get_excel_range path nil  nil nil)
;;;Функция попробует открыть файл по указанному пути и, если удастся открыть, попросит подсветить диапазон вручную
;;; - без каких либо параметров
;;;Фyнкция попросит открыть файл и подсветить диапазон вручную
;;;
;;;!!!Проверка на корректность задания диапазона не производится!!!
;;;
;;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun get_excel_range     (
                path
                sheet_name_or_number
                r1
                c1
                /
                already_opened
                ExcelApp
                WorkBook
                used_range
                lst
                lis
                liss
                               temp_index
                num_of_collumns
                num_of_rows
                row
                col
                close_app
                old_error
               )
(setq old_error *error*)
  (defun *error* (msg)
    (setq *error* old_error)
    (setq old_error nil)
       (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke-method (list WorkBook "Save")))
       (if close_app (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke-method (list ExcelApp "Quit"))))
        (mapcar
            (function (lambda (x)
                    (if (and x (if (not (vl-catch-all-error-p x)) (not (vlax-object-released-p x)) nil))
                    (vlax-release-object x)
                        )
                  )
            )
  (list used_range sheet WorkBook ExcelApp)
)
(setq used_range nil sheet nil WorkBook nil ExcelApp nil)
     (gc) (gc)
    (princ (strcat "\nError: " msg))
    (princ)
); end *error*
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (if (not (setq ExcelApp (vlax-get-object "Excel.Application")))
    (setq ExcelApp (vlax-create-object "Excel.Application")
          close_app :vlax-true))
  (if path ;если путь задан
     (if (not (vl-catch-all-error-p
                (progn
        (princ "\nTrying to open Excel file. Please wait.\n")
        (setq WorkBook (vl-catch-all-apply 'vla-open (list (vlax-get-property ExcelApp "WorkBooks") path)))
           )))
        ;если удалось открыть файл
       (progn
      (if sheet_name_or_number
        (if (not (vl-catch-all-error-p (setq sheet (vl-catch-all-apply 'vlax-get-property (list (vlax-get-property WorkBook "Sheets") "Item" sheet_name_or_number)))))
        (vlax-invoke-method sheet "Activate")
        (princ "\nThe given sheet name is not correct")
        )
      )
      (if (and r1 c1); Если задан диапазон
        (progn
            (vlax-invoke-method WorkBook "Activate"); активировать открытый документ
            (setq used_range (vlax-get-property ExcelApp 'Range (vlax-make-variant r1) (vlax-make-variant c1)); получение указателя на выделенную область
                  lst (vlax-safearray->list (vlax-variant-value (vlax-get-property used_range 'Value)))) ;; получение списка данных с екселя
        )
        ;Если диапазон не задан
        (progn
          ;сказать об этом и попросить указать диапазон вручную
         (princ "\nNo range given. Highlight data area manualy")
             (vlax-put-property ExcelApp 'Visible :vlax-true)
                 (getstring "\nselect data area in Excel and then press enter"); ожидать нажатие клавиши
                 (setq used_range (vlax-get-property ExcelApp 'Selection); получение указателя на выделенную область
                       lst(vlax-safearray->list (vlax-variant-value (vlax-get-property used_range 'Value)))) ;; получение списка данных с екселя
        )
      )
    )
             (progn ;Если файл не открылся
         ;сказать об этом и попросить указать диапазон вручную
         (princ "\nError while opening file. Highlight data area manualy")
         (vlax-put-property ExcelApp 'Visible :vlax-true)
                 (getstring "\nselect data area in Excel and then press enter"); ожидать нажатие клавиши
                 (setq used_range (vlax-get-property ExcelApp 'Selection); получение указателя на выделенную область
                       lst (vlax-safearray->list (vlax-variant-value (vlax-get-property used_range 'Value)))) ;; получение списка данных с екселя
             )
     )
    ;Если путь не задан
             (progn
          ;сказать об этом и попросить указать диапазон вручную
         (princ "\nNo range given. Highlight data area manualy")
             (vlax-put-property ExcelApp 'Visible :vlax-true)
                 (getstring "\nselect data area in Excel and then press enter"); ожидать нажатие клавиши
                 (setq used_range (vlax-get-property ExcelApp 'Selection); получение указателя на выделенную область
                       lst (vlax-safearray->list (vlax-variant-value (vlax-get-property used_range 'Value)))) ;; получение списка данных с екселя
              )
  )
;;;**************************************************************************************
      (setq num_of_rows (length lst);вычислить кол-во строк
            num_of_collumns (/ (vlax-get-property used_range 'Count) num_of_rows)) ;вычислить Кол-во столбцов
                    (setq lis '() temp_index 0);;
                      (while (/= (1- (1- temp_index)) num_of_rows)
                          (setq lis (append lis (nth temp_index lst))
                    temp_index (1+ temp_index))
                      );;end while
               ;;инициализация текущих переменных
                    (setq liss '() row 1 col 1)
               ;; Формирование списка, содержащего элементы типа (Nстроки Nстолбца элемент)
         (foreach n lis
         (setq liss
            (cons
              (list row
                col
               (if (/= (vlax-variant-value n) nil)
                (if    (/= 'STR (type (vlax-variant-value n)))
                  (rtos (vlax-variant-value n) 2 2)
                  (vlax-variant-value n)
                )
                 "Empty"
               )
              )
              liss
            )
         )
         (setq col (1+ col))
         (if (> col num_of_collumns) (progn (setq col 1) (setq row (1+ row))))
     )
;; Закрытие Екселя
(vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke-method (list WorkBook "Save")))
(if close_app (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke-method (list ExcelApp "Quit"))))
(mapcar
  (function (lambda (x)
          (if (and x (if (not (vl-catch-all-error-p x)) (not (vlax-object-released-p x)) nil))
          (vlax-release-object x)
              )
        )
  )
  (list used_range sheet WorkBook ExcelApp)
)
(setq used_range nil sheet nil WorkBook nil ExcelApp nil)
     (gc) (gc)
     (reverse liss)
)