Author Topic: Excel library subs  (Read 26074 times)

0 Members and 1 Guest are viewing this topic.

alanjt

  • Needs a day job
  • Posts: 5340
  • Standby for witty remark...
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

Matt__W

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: Excel library subs
« Reply #16 on: May 31, 2011, 01:35:29 PM »
maybe you and se7en could start a support group :P
You'll have to check with Krush and see if he's accepting any new applicants at this time.   :wink:
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

VVA

  • Newt
  • Posts: 166
Re: Excel library subs
« Reply #17 on: May 31, 2011, 02:52:05 PM »
And how about these from ElpanovEvgeniy:
http://www.theswamp.org/index.php?topic=10101.0
Last release from ElpanovEvgeniy's site

And
KozMos VLXLS Project

gile

  • Water Moccasin
  • Posts: 2275
  • Marseille, France
Re: Excel library subs
« Reply #18 on: May 31, 2011, 05:37:01 PM »
Hi,

There's also Patrick_35's Api_Xls here:
http://www.theswamp.org/index.php?topic=35157.0

And here's the one I use these days, it seems to work fine with Excel 2003 (.xls) and Excel 2010 (.xls or .xlsx)

Code: [Select]
;;-------------------------------------------------------------------------------
;; gc:WriteExcel
;; Ecrit dans un fichier Excel
;;
;; Arguments : 4
;;   filename   : chemin complet du fichier
;;   sheet      : nom de la feuille (ou nil pour la feuille courante)
;;   startRange : nom de la cellule de départ (ou nil pour "A1")
;;   dataList   : liste de sous-listes contenant les données (une sous liste par rangée)
;;-------------------------------------------------------------------------------
(defun gc:WriteExcel (filename sheet startRange   dataList /     *error*  xlApp
      wBook    save sheets active   start    row     col      rng
      n        cell
     )
  (vl-load-com)

  (defun *error* (msg)
    (and msg
(/= msg "Fonction annulée")
(princ (strcat "\nErreur: " msg))
    )
    (and wBook (vlax-invoke-method wBook 'Close :vlax-False))
    (and xlApp (vlax-invoke-method xlApp 'Quit))
    (and reg (vlax-release-object reg))
    (mapcar (function (lambda (obj) (and obj (vlax-release-object obj))))
    (list cell rng wBook xlApp)
    )
    (gc)
  )

  (setq xlapp (vlax-get-or-create-object "Excel.Application"))

  (if (findfile filename)
    (setq wBook (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Open filename)
  save T
    )
    (setq wBook (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Add))
  )

  (if sheet
    (progn
      (setq sheets (vlax-get-property xlApp 'Sheets))
      (vlax-for s sheets
(if (= (strcase (vlax-get-property s 'Name)) (strcase sheet))
  (progn
    (vlax-invoke-method s 'Activate)
    (setq active T)
  )
)
      )
      (or active
  (vlax-put-property (vlax-invoke-method sheets 'Add) 'Name sheet)
      )
    )
  )

  (if startRange
    (setq start (gc:ColumnRow startRange)
  col (car start)
  row (cadr start)
    )
    (setq col 1
  row 1
    )
  )

  (setq rng (vlax-get-property xlApp 'Cells))
  (vlax-invoke-method rng 'Clear)
  (foreach sub dataList
    (setq n col)
    (foreach data sub
      (setq cell (vlax-variant-value (vlax-get-property rng 'Item row n)))
      (if (= (type data) 'STR)
(vlax-put-property cell 'NumberFormat "@")
      )
      (vlax-put-property cell 'Value2 data)
      (setq n (1+ n))
    )
    (setq row (1+ row))
  )

  (vlax-invoke-method
    (vlax-get-property
      (vlax-get-property xlApp 'ActiveSheet)
      'Columns
    )
    'AutoFit
  )

  (if save
    (vlax-invoke-method wBook 'Save)
    (if (and
  (< "11.0" (vlax-get-property xlapp "Version"))
  (= (strcase (vl-filename-extension filename) T) ".xlsx")
)
      (vlax-invoke-method wBook 'SaveAs filename 51 "" "" :vlax-false :vlax-false 1 1)
      (vlax-invoke-method wBook 'SaveAs filename -4143 "" "" :vlax-false :vlax-false 1 1)
    )
  )

  (*error* nil)
)

;;-------------------------------------------------------------------------------
;; gc:ReadExcel
;; Retourne une liste de sous-listes contenant les données (une sous liste par rangée)
;; d'un fichier Excel
;;
;; Arguments : 4
;;   filename   : chemin complet du fichier
;;   sheet      : nom de la feuille (ou nil pour la feuille courante)
;;   startRange : nom de la cellule de départ (ou nil pour "A1")
;;   maxRange   : nom de la cellule où doit s'arrêter la lecture (nil pour toute la plage)
;;-------------------------------------------------------------------------------
(defun gc:ReadExcel (filename  sheet startRange      maxRange  / *error*
     xlApp     wBook startCell startCol  startRow  maxCell maxCol
     maxRow    reg col    row      data      sub lst
    )

  (defun *error* (msg)
    (and msg
(/= msg "Fonction annulée")
(princ (strcat "\nErreur: " msg))
    )
    (and wBook (vlax-invoke-method wBook 'Close :vlax-False))
    (and xlApp (vlax-invoke-method xlApp 'Quit))
    (and reg (vlax-release-object reg))
    (mapcar (function (lambda (obj) (and obj (vlax-release-object obj))))
    (list rng wBook xlApp)
    )
    (gc)
  )

  (setq xlapp (vlax-get-or-create-object "Excel.Application")
wBook (vlax-invoke-method (vlax-get-property xlApp 'WorkBooks) 'Open filename)
  )

  (if sheet
    (vlax-for ws (vlax-get-property xlapp 'Sheets)
      (if (= (vlax-get-property ws 'Name) sheet)
(vlax-invoke-method ws 'Activate)
      )
    )
  )

  (if startRange
    (setq startCell (gc:ColumnRow startRange)
  startCol  (car startCell)
  startRow  (cadr startCell)
    )
    (setq startRange
   "A1"
  startCol 1
  startRow 1
    )
  )

  (if maxRange
    (setq maxCell (gc:ColumnRow MaxRange)
  maxCol  (1+ (car MaxCell))
  maxRow  (1+ (cadr MaxCell))
    )
    (setq reg (vlax-get-property
   (vlax-get-property
     (vlax-get-property xlApp 'ActiveSheet)
     'Range
     startRange
   )
   'CurrentRegion
)
  maxRow (+ (vlax-get-property reg 'Row)
    (vlax-get-property (vlax-get-property reg 'Rows) 'Count)
)
  maxCol (+ (vlax-get-property reg 'Column)
    (vlax-get-property (vlax-get-property reg 'Columns) 'Count)
)
    )
  )

  (setq rng (vlax-get-property xlApp 'Cells)
row maxRow
  )
  (while (< startRow row)
    (setq sub nil
  col maxCol
  row (1- row)
    )
    (while (< startCol col)
      (setq col (1- col)
    sub (cons
  (vlax-variant-value
    (vlax-get-Property
      (vlax-variant-value (vlax-get-property rng 'Item row col))
      'Value2
    )
  )
  sub
)
      )
    )
    (setq lst (cons sub lst))
  )

  (*error* nil)

  lst
)

;;-------------------------------------------------------------------------------
;; gc:ColumnRow - Retourne une liste des indices de colonne et rangée
;; Arguments: 1
;;   Cell = Référence de la cellule
;; Exemple de syntaxe : (gc:ColumnRow "IV987") -> (256 987)
;;-------------------------------------------------------------------------------
(defun gc:ColumnRow (cell / col char row)
  (setq col "")
  (while (< 64 (ascii (setq char (strcase (substr cell 1 1)))) 91)
    (setq col  (strcat col char)
  cell (substr cell 2)
    )
  )
  (if (and (/= col "") (numberp (setq row (read Cell))))
    (list (gc:Alpha2Number col) row)
    '(1 1) ;_ default to "A1" if there's a problem
  )
)

;;-------------------------------------------------------------------------------
;; gc:Alpha2Number - Convertit une chaîne alphabétique en nombre entier
;; Function By: Gilles Chanteau from Marseille, France
;; Arguments: 1
;;   str = Chaîne à convertir
;; Exemple de syntaxe : (gc:Alpha2Number "BU") = 73
;;-------------------------------------------------------------------------------
(defun gc:Alpha2Number (str / num)
  (if (= 0 (setq num (strlen str)))
    0
    (+ (* (- (ascii (strcase (substr str 1 1))) 64)
  (expt 26 (1- num))
       )
       (gc:Alpha2Number (substr str 2))
    )
  )
)

;;-------------------------------------------------------------------------------
;; gc:Number2Alpha - Convertit un nombre entier en chaîne alphabétique
;; Function By: Gilles Chanteau from Marseille, France
;; Arguments: 1
;;   num = Nombre à convertir
;; Exemple de syntaxe : (gc:Number2Alpha 73) = "BU"
;;-------------------------------------------------------------------------------
(defun gc:Number2Alpha (num / val)
  (if (< num 27)
    (chr (+ 64 num))
    (if (= 0 (setq val (rem num 26)))
      (strcat (gc:Number2Alpha (1- (/ num 26))) "Z")
      (strcat (gc:Number2Alpha (/ num 26)) (chr (+ 64 val)))
    )
  )
)
« Last Edit: June 03, 2011, 04:21:40 AM by gile »
Speaking English as a French Frog

John Kaul (Se7en)

  • Administrator
  • Needs a day job
  • Posts: 9667
Re: Excel library subs
« Reply #19 on: May 31, 2011, 06:40:22 PM »
maybe you and se7en could start a support group :P

I thought it was:

Maybe you and Se7en could start a support group.

I could be wrong...
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

John Kaul (Se7en)

  • Administrator
  • Needs a day job
  • Posts: 9667
Re: Excel library subs
« Reply #20 on: May 31, 2011, 06:43:02 PM »
General question: Should I "*bump*" the "My dog ate it" thread again?

Ref:
Somewhat off topic, but I have to agree with jbuzbee.  This site is incredibly hard to search and have meaningful results.  Punctuation gets stripped out, and there's no way to search for a phrase that I can find.  Yesterday I wanted to look for      (command "text"      as a phrase.  103 pages of results were returned.  If I limit the search to the lisp and "show your stuff" forums it is still 51 pages.  The search function would be fine for most sites, but for a site that deals with programming languages it leaves a lot to be desired.  I also wish that there was a way to make the forum selections sticky instead of having search default to all forums. 

I don't mean for this to be taken as a complaint.  More a "wish list" suggestion.  This is a great site, and one that I've benefited from greatly. 
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

adalea03

  • Guest
Re: Excel library subs
« Reply #21 on: March 11, 2012, 10:20:23 PM »
Gile,
I'm dull; I know. Mostly I only open my mouth to change feet.
But I am unclear about the sintax regarding the line in your gc:writeexcel function header...
";; dataList: list of sublists containing the data (a list by row) ".
Is it ("cell address1" "value1") ("cell address2" "value2") ... ?
Also, If my target sell has a defined name [i.e. "(ProjectNumber" "1022-2012")],
where "ProjectNumber" = cell "B12 ", can I employ that defined name as the cell address?
Thank you for your guidance, in advance.
Tony

fixo

  • Guest
Re: Excel library subs
« Reply #22 on: March 12, 2012, 04:26:06 AM »
Try this code snip
Code: [Select]
(setq xlapp    (vlax-get-or-create-object "Excel.Application")
xlbooks  (vlax-get-property xlapp 'Workbooks)
xlbook    (vlax-invoke-method xlbooks 'Add)
xlsheets (vlax-get-property xlbook 'Sheets)
xlsheet    (vlax-get-property xlsheets 'Item 1)
xlcells    (vlax-get-property xlsheet 'Cells)
)
 
 
  (vla-put-visible xlapp :vlax-true)
;;..........................................
(setq address "B12"
      text "ProjectName")
(setq xlrange(vl-catch-all-apply
    'vlax-get-property
    (list xlcells
  'Range
  (vlax-make-variant address 8))))
(vl-catch-all-apply
    'vlax-put-property
    (list xlrange
  'Value2
  (vlax-make-variant text 8)))

~'J'~

andrew_nao

  • Swamp Rat
  • Posts: 566
Re: Excel library subs
« Reply #23 on: March 12, 2012, 09:27:00 AM »
OK, before you yell at me I did try to search using "Excel" but you guys use the term "Excellent" WAY too much around here!  :-D

Excellent!  Thanks!!

 :-)

was this diliberate?

 :-)

adalea03

  • Guest
Re: Excel library subs
« Reply #24 on: March 12, 2012, 10:08:28 AM »
Thanks, Fixo

That snippet opened a new workbook and placed the "ProjectName" in cell "B12".
So, all seems well regarding VisualLisp>Excel communications.
However, I have a specific xls file that I want to update with various cell addresses and values.
So, how do I apply that snippet to a specific XL file?
Also, do the vla-objects need to be released in any particular order?

Tony

fixo

  • Guest
Re: Excel library subs
« Reply #25 on: March 12, 2012, 03:51:08 PM »
Sorry for the belating was busy
I will show you how to do it tomorrow
You have to release objects in order from childs to
parent, thus excel application would be released
at the very end

~'J'~

fixo

  • Guest
Re: Excel library subs
« Reply #26 on: March 12, 2012, 04:25:10 PM »

So, how do I apply that snippet to a specific XL file?

Tony

Found it
Code: [Select]
  ;;----------------------------XLDEMO.LSP-------------------------------;;

  ;; fixo (02012 * all rights released
  ;; 3/1/12
  ;; edited 3/13/12
(defun C:XLDEMO  (/ *error* data filepath fname prop selrange value xlapp xlbook xlcells xlsheet xlsheets)


  (defun *error* (msg)
  (if
    (vl-position
      msg
      '("console break"
"Function cancelled"
"quit / exit abort"
       )
    )
     (princ "Error!")
     (princ msg)
  )

  (princ)
)
  ;;;local defun
(defun setcelltext(cells row column value)
  (vl-catch-all-apply
    'vlax-put-property
    (list cells 'Item row column
(vlax-make-variant
   (vl-princ-to-string value) 8)))
  )

;;;local defun
  (defun wraptext (strlst / txtvalue)
  (setq txtvalue "")
  (while (cadr strlst)
    (setq txtvalue (strcat txtvalue (strcat (car strlst) (chr 10) (chr 13))))
    (setq strlst (cdr strlst))
  )
  (setq txtvalue (strcat txtvalue (last strlst)))
  txtvalue
)
 
;;; local defun
(defun wrapcelltext (xapp cells xlrange txt_list)
(setq  txt_list (wraptext txt_list)
       )
  (vl-catch-all-apply 'vlax-invoke-method (list xlrange 'Select)
    )
  (setq selrange (vl-catch-all-apply 'vlax-get-property (list xapp 'Selection)))
  (mapcar '(lambda (prop value)
     (vl-catch-all-apply
       'vlax-put-property
       (list selrange
     prop
     value
       )
     )
   )

  (list 'HorizontalAlignment 'VerticalAlignment 'WrapText
'Orientation 'AddIndent 'IndentLevel 'ShrinkToFit 'ReadingOrder
'MergeCells 'Value2
       )

  (list -4143 -4108 :vlax-true 0 :vlax-false 0 :vlax-false -5102 :vlax-true txt_list)
  )

)
;;; local defun
(defun setcellbyaddress(xlcells address text / xlrange)

(setq xlrange(vl-catch-all-apply
     'vlax-get-property
     (list xlcells
   'Range
   (vlax-make-variant address 8))))
(vl-catch-all-apply
     'vlax-put-property
     (list xlrange
   'Value2
   (vlax-make-variant text 8)))
  )
 
 
  ;;; main part ;;;
 
  (setq data (list (cons "A1" "Text in cell A1")
   (cons "B2" "Text in cell B2")
   (cons "C4" "Text in cell C4")
   (cons "B12" "Text in cell B12")
   (cons "D20" "Text in cell D20")
   (cons "E9" "Text in cell E9")
)
)



   (setq filepath (getfiled "* Open an Excel file to get value of selection : *"
(getvar "dwgprefix")
"xls"
12
      )
  )

(setq xlapp (vlax-get-or-create-object "Excel.Application"))
(vla-put-visible xlapp :vlax-true)
(setq xlbook (vl-catch-all-apply 'vla-open
     (list (vlax-get-property xlapp 'Workbooks)
                           filepath)
                              )
xlsheets (vlax-get-property xlbook 'Sheets)
xlsheet    (vlax-get-property xlsheets 'Item 1);<-- change sheet name or number here
xlcells    (vlax-get-property xlsheet 'Cells)
)
 
 
  (vla-put-visible xlapp :vlax-true)

(foreach item data

(setcellbyaddress xlcells (car item)(cdr item))
 
)

 
;;; (vlax-invoke-method
;;;   (vlax-get-property xlsheet 'Columns)
;;;   'AutoFit);optional
 


(vlax-invoke-method
    xlbook
    'SaveAs
    filepath
    nil
    nil
    nil
    :vlax-false
    :vlax-false
    1
    2
  )
(vlax-invoke-method
    xlbook 'Close)
(vlax-invoke-method
    xlapp 'Quit)
  (mapcar '(lambda (x)
     (vl-catch-all-apply
       '(lambda ()
  (vlax-release-object x)
)
     )
   )
  (list xlcells xlsheet xlsheets xlbook  xlapp)
  )
  (setq  xlapp nil)
  (gc)(gc)(gc)
  (alert (strcat "File saved as:\n" fname))
  (*error* nil)
  (princ)
  )
(prompt "\n\t\t---\tStart command with XlDEMO\t---\n")
(princ)

(or (vl-load-com)
    (princ))

  ;;----------------------------code end-------------------------------;;

[code]

adalea03

  • Guest
Re: Excel library subs
« Reply #27 on: March 12, 2012, 05:18:50 PM »
Thanks, fixo.
Let me digest this, til tomorrow.

fixo

  • Guest
Re: Excel library subs
« Reply #28 on: March 12, 2012, 05:23:12 PM »
Haha
sleep with angels
:)

andrew_nao

  • Swamp Rat
  • Posts: 566
Re: Excel library subs
« Reply #29 on: March 14, 2012, 08:21:08 AM »
it there a way to count how many filled rows there are in an excel file?