Exportar Excel e formatar células

Exportar Excel e formatar células

edsaqueteAG5Q7
Enthusiast Enthusiast
1,567 Views
12 Replies
Message 1 of 13

Exportar Excel e formatar células

edsaqueteAG5Q7
Enthusiast
Enthusiast

Preciso de ajuda, não estou conseguindo formatar a célula no excel para texto, assim alguns números não vira data, e caso seja possível alterar a cor das células da primeira linha.



(defun c:test ( / *error* arq A B C o) (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end")) (princ (strcat "\nError: " errmsg))) (if arq (close arq)) (princ)) (setq narq (getfiled "Selecione o Nome e Local" "PLANILHA CTO" "csv" 1)) (setq arq (open narq "w")) (write-line "Col1;Col2;Col3;Col4;Col5;Col6" arq ) (setq A '(("0001" "aa" "01-01" "x001") ("0002" "aa" "002" "x002") ) B '(("0001" "bb" "c01" "d002")) C A) (foreach i B (if (setq o (assoc (car i) A)) (setq C (subst (append o (cdr i)) o C)))) (foreach e C (write-line (apply 'strcat (mapcar '(lambda (x) (strcat x ";")) e)) arq)) (if arq (close arq)) (princ)))

 

0 Likes
Accepted solutions (1)
1,568 Views
12 Replies
Replies (12)
Message 2 of 13

ВeekeeCZ
Consultant
Consultant

Import it the other way around.

Run Excel, use Data / Import Txt/Csv ... then save it as *.xls.

0 Likes
Message 3 of 13

edsaqueteAG5Q7
Enthusiast
Enthusiast
Desculpa mais ainda estou aprendendo a programar, poderia me explicar mais detalhado.

Obrigado
0 Likes
Message 4 of 13

ВeekeeCZ
Consultant
Consultant

It really has nothing to do with programming experience. It's Excel.

 

Z9E3zK5E_0-1637428089736.png

 

0 Likes
Message 5 of 13

Sea-Haven
Mentor
Mentor

This forum is English based so post both, use Google Translate.

 

"I'm sorry even more I'm learning to program, could you explain it to me more detailed."

 

Also Double click in explorer csv file Excel will open file Automatically, or Start Excel File choose csv file

Google translate

Também clique duas vezes no arquivo do explorador csv O Excel abrirá o arquivo automaticamente ou o Arquivo Iniciar Excel escolherá o arquivo csv

0 Likes
Message 6 of 13

hosneyalaa
Advisor
Advisor

hi

this is an Example

 

If you want to learn more, you should visit this site

https://docs.microsoft.com/en-us/office/vba/api/excel.shapes.addpicture

 (defun C:test (/ CLL COLM DATA EXCELAPP FILEPATH FOR HEADER_LIST INVISIBLE MASTERLIST MODE OR RANG ROW SHT SHTNUM SOURCERANGE SOURCEWBK TARGETSHT TARGETSHTS TARGETWBK WBK X)
  (vl-load-com)
 
    (setq FilePath (getfiled "Select Excel file to read :"
   (getvar "dwgprefix")
   "XLSX;XLS"
   16
       )
  )
  (setq ShtNum 1)
   
 
  (setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
  (vla-put-visible ExcelApp :vlax-true)""or :vlax-false for invisible mode
  (setq Wbk (vl-catch-all-apply 'vla-open
       (list (vlax-get-property ExcelApp "WorkBooks") FilePath)))
  (setq Sht (vl-catch-all-apply 'vlax-get-property
          (list (vlax-get-property Wbk "Sheets")
         "Item" ShtNum)))
      (vlax-invoke-method Sht "Activate")
  (setq cll (vlax-get-property Sht "Cells"))

   (setq row 1
	 colm 1
	 )

   
   (setq header_list '("Col1""Col2""Col3""Col4""Col5""Col6")) 
   (repeat (length header_list)
     (vlax-put-property
       cll
       "Item"
       row
       colm
       (vl-princ-to-string (car header_list))
       )
       
     
     (setq colm (1+ colm)
	   header_list
	    (cdr header_list)
	   )
     )
(setq Rang (vlax-get-property Sht "Range" "A1:f1"))
         (vlax-put-property (vlax-get-property Rang "Interior")
                          "Colorindex" (vlax-make-variant 4))
   (setq row 2
colm 1
)
  (setq MasterList '(("0001" "aa" "01-01" "x001") ("0002" "aa" "002" "x002") ))

   (repeat (length MasterList)
     (setq data (car MasterList))
     (vlax-put-property
       cll
       "Item"
       row
       colm
       (vl-princ-to-string (car data))
       )
     (setq colm (1+ colm))
     (vlax-put-property
       cll
       "Item"
       row
       colm
       (vl-princ-to-string (cadr data))
       )
     (setq colm (1+ colm))
     (vlax-put-property
       cll
       "Item"
       row
       colm
       (vl-princ-to-string (caddr data))
       )
     (setq colm (1+ colm))
     (vlax-put-property
       cll
       "Item"
       row
       colm
       (vl-princ-to-string (cadddr data))
       )
     (setq colm (1+ colm))
     
     
     (setq MasterList (cdr MasterList))
     (setq row	(1+ row)
	   colm 1
	   )
     )



    (vl-catch-all-apply
  'vlax-invoke-method
  (list Wbk "Close" :vlax-true)
  )

  
(vl-catch-all-apply
  'vlax-invoke-method
  (list ExcelApp "Quit")
  )



   (mapcar
  (function
    (lambda (x)
      (vl-catch-all-apply
 (function (lambda ()
      (progn
        (if (not (vlax-object-released-p x))
   (progn
     (vlax-release-object x)
     (setq x nil)
     )
   )
        )
      )
    )
 )
      )
    )
  (list  sourceRange TargetSht TargetWbk SourceWbk TargetShts TargetSht Sht Wbk ExcelApp)
  )
  (gc)
  (gc)
  (gc)
  (princ)
  
)



 

 

Capture.JPG

0 Likes
Message 7 of 13

edsaqueteAG5Q7
Enthusiast
Enthusiast

sorry for not translating into english

The image below shows how you are exporting today, and how I want to export.

I don't want to change the export mode, I just want to change the formatting of the cells in line 1 which would be the title by changing the color of the cells, and change the formatting of all cells from "Col3" to "text" to not become a date.

Here in Brazil we use the ";".

 

edsaqueteAG5Q7_0-1637493024991.png

 

0 Likes
Message 8 of 13

hosneyalaa
Advisor
Advisor

Add this is FOR every cell's

 

;; Set text format :
   (vlax-put-property Cel "NumberFormat" (vlax-make-variant "@" 8))
   
0 Likes
Message 9 of 13

edsaqueteAG5Q7
Enthusiast
Enthusiast
Friend would have to insert in the lisp that I sent the column formatting and change the line color in the range A1 to F1.
0 Likes
Message 10 of 13

hosneyalaa
Advisor
Advisor

 

try

 

 (defun C:test (/ CLL COLM DATA EXCELAPP FILEPATH FOR HEADER_LIST INVISIBLE MASTERLIST MODE OR RANG ROW SHT SHTNUM SOURCERANGE SOURCEWBK TARGETSHT TARGETSHTS TARGETWBK WBK X)
  (vl-load-com)
 
    (setq FilePath (getfiled "Select Excel file to read :"
   (getvar "dwgprefix")
   "XLSX;XLS"
   16
       )
  )
  (setq ShtNum 1)
   
 
  (setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
  (vla-put-visible ExcelApp :vlax-true);;; or :vlax-false for invisible mode
  (setq Wbk (vl-catch-all-apply 'vla-open
       (list (vlax-get-property ExcelApp "WorkBooks") FilePath)))
  (setq Sht (vl-catch-all-apply 'vlax-get-property
          (list (vlax-get-property Wbk "Sheets")
         "Item" ShtNum)))
      (vlax-invoke-method Sht "Activate")
  (setq cll (vlax-get-property Sht "Cells"))

   (setq row 1
	 colm 1
	 )

   
   (setq header_list '("Col1""Col2""Col3""Col4""Col5""Col6")) 
   (repeat (length header_list)
     (vlax-put-property
       cll
       "Item"
       row
       colm
       (vl-princ-to-string (car header_list))
       )
       
     
     (setq colm (1+ colm)
	   header_list
	    (cdr header_list)
	   )
     )
   
(setq Rang (vlax-get-property Sht "Range" "A1:f1"))
         (vlax-put-property (vlax-get-property Rang "Interior")
                          "Colorindex" (vlax-make-variant 4))
   (setq row 2
colm 1
)
  (setq MasterList '(("0001" "aa" "01-01" "x001") ("0002" "aa" "002" "x002") ))

   (repeat (length MasterList)
     (setq data (car MasterList))
     (vlax-put-property
       cll
       "Item"
       row
       colm
       (vl-princ-to-string (car data))
       )
     (setq colm (1+ colm))
     (vlax-put-property
       cll
       "Item"
       row
       colm
       (vl-princ-to-string (cadr data))
       )
     (setq colm (1+ colm))
    
       

   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       (setq Cel (vlax-variant-value
      (vlax-get-property cll "Item"
        ;; row number :
        (vlax-make-variant row)
        ;; column number :
        (vlax-make-variant colm))))
   
 ;; Set text format :
   (vlax-put-property Cel "NumberFormat" (vlax-make-variant "@" 8))
   
     (vlax-put-property
       cll
       "Item"
       row
       colm
       (vl-princ-to-string (caddr data))
       )
   
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  

   
     (setq colm (1+ colm))
     (vlax-put-property
       cll
       "Item"
       row
       colm
       (vl-princ-to-string (cadddr data))
       )
     (setq colm (1+ colm))
     
     
     (setq MasterList (cdr MasterList))
     (setq row	(1+ row)
	   colm 1
	   )
     );(repeat



    (vl-catch-all-apply
  'vlax-invoke-method
  (list Wbk "Close" :vlax-true)
  )

  
(vl-catch-all-apply
  'vlax-invoke-method
  (list ExcelApp "Quit")
  )



   (mapcar
  (function
    (lambda (x)
      (vl-catch-all-apply
 (function (lambda ()
      (progn
        (if (not (vlax-object-released-p x))
   (progn
     (vlax-release-object x)
     (setq x nil)
     )
   )
        )
      )
    )
 )
      )
    )
  (list  sourceRange TargetSht TargetWbk SourceWbk TargetShts TargetSht Sht Wbk ExcelApp)
  )
  (gc)
  (gc)
  (gc)
  (princ)
  
)



 

 

 

Capture.JPG

0 Likes
Message 11 of 13

edsaqueteAG5Q7
Enthusiast
Enthusiast
Your lisp is asking to open an existing excel file, I want to generate a new file as it was in my initial lisp, in my lisp it is already generating right, I would just like to add the cell formatting.
0 Likes
Message 12 of 13

hosneyalaa
Advisor
Advisor
Accepted solution

Hi
Try this it does not ask where to save the file
It saves it to the AutoCAD file location with the same name

 

(defun C:test (/ CEL CLL COLM DATA DWGNAME EXCELAPP HEADER_LIST LEN MASTERLIST PDFNAME RANG ROW SHT SOURCERANGE SOURCEWBK TARGETSHT TARGETSHTS TARGETWBK WBK WBKAD X)
  (vl-load-com)
  
  
  (setq dwgname (GETVAR "dwgname"))
  (setq len (strlen dwgname))
  
  (setq dwgname (substr dwgname 1 (- len 4)))
  
  
  
  (setq pdfname (strcat (getvar "dwgprefix")  dwgname))
  (setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
  (vla-put-visible ExcelApp :vlax-false)
  (setq Wbk (vlax-get-property ExcelApp "WorkBooks"))
  (setq WbkAD (vlax-invoke-method Wbk "add"))
  (setq Sht (vl-catch-all-apply 'vlax-get-property
	      (list (vlax-get-property WbkAD "Sheets")
		    "Item" 1)))
  (vlax-invoke-method Sht "Activate")
  (setq cll (vlax-get-property Sht "Cells"))
  
  (setq row 1
	colm 1
	)
  
  
  (setq header_list '("Col1""Col2""Col3""Col4""Col5""Col6"))
  (repeat (length header_list)
    (vlax-put-property
      cll
      "Item"
      row
      colm
      (vl-princ-to-string (car header_list))
      )
    
    
    (setq colm (1+ colm)
	  header_list
	   (cdr header_list)
	  )
    )
  
  (setq Rang (vlax-get-property Sht "Range" "A1:f1"))
  (vlax-put-property (vlax-get-property Rang "Interior")
    "Colorindex" (vlax-make-variant 4))
  (setq row 2
	colm 1
	)
  (setq MasterList '(("0001" "aa" "01-01" "x001") ("0002" "aa" "002" "x002") ))
  
  
  
  (repeat (length MasterList)
    (setq data (car MasterList))
    
    
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq Cel (vlax-variant-value
		(vlax-get-property cll "Item"
		  ;; row number :
		  (vlax-make-variant row)
		  ;; column number :
		  (vlax-make-variant colm))))
    
    ;; Set text format :
    (vlax-put-property Cel "NumberFormat" (vlax-make-variant "@" 8))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
    (vlax-put-property
      cll
      "Item"
      row
      colm
      (vl-princ-to-string (car data))
      )
    
    
    
    
    
    (setq colm (1+ colm))
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq Cel (vlax-variant-value
		(vlax-get-property cll "Item"
		  ;; row number :
		  (vlax-make-variant row)
		  ;; column number :
		  (vlax-make-variant colm))))
    
    ;; Set text format :
    (vlax-put-property Cel "NumberFormat" (vlax-make-variant "@" 8))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
    
    (vlax-put-property
      cll
      "Item"
      row
      colm
      (vl-princ-to-string (cadr data))
      )
    
    
    
    
    
    (setq colm (1+ colm))
    
    
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq Cel (vlax-variant-value
		(vlax-get-property cll "Item"
		  ;; row number :
		  (vlax-make-variant row)
		  ;; column number :
		  (vlax-make-variant colm))))
    
    ;; Set text format :
    (vlax-put-property Cel "NumberFormat" (vlax-make-variant "@" 8))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
    
    (vlax-put-property
      cll
      "Item"
      row
      colm
      (vl-princ-to-string (caddr data))
      )
    
    
    
    
    (setq colm (1+ colm))
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq Cel (vlax-variant-value
		(vlax-get-property cll "Item"
		  ;; row number :
		  (vlax-make-variant row)
		  ;; column number :
		  (vlax-make-variant colm))))
    
    ;; Set text format :
    (vlax-put-property Cel "NumberFormat" (vlax-make-variant "@" 8))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
    
    
    
    (vlax-put-property
      cll
      "Item"
      row
      colm
      (vl-princ-to-string (cadddr data))
      )
    
    
    
    
    
    
    
    (setq colm (1+ colm))
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq Cel (vlax-variant-value
		(vlax-get-property cll "Item"
		  ;; row number :
		  (vlax-make-variant row)
		  ;; column number :
		  (vlax-make-variant colm))))
    
    ;; Set text format :
    (vlax-put-property Cel "NumberFormat" (vlax-make-variant "@" 8))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
    
    
    
    (setq MasterList (cdr MasterList))
    (setq row	(1+ row)
	  colm 1
	  )
    
    
    
    );(repeat
  
  
  
  
  
  
  
  
  
  
  
  
  (vlax-invoke-method
    WbkAD
    "SaveAs"
    pdfname
    51
    nil
    nil
    :vlax-false
    :vlax-false
    1
    2
    )
  
  
  (vl-catch-all-apply
    'vlax-invoke-method
    (list WbkAD "Close" :vlax-true)
    )
  
  
  (vl-catch-all-apply
    'vlax-invoke-method
    (list ExcelApp "Quit")
    )
  
  
  
  (mapcar
    (function
      (lambda (x)
	(vl-catch-all-apply
	  (function (lambda ()
		      (progn
			(if (not (vlax-object-released-p x))
			  (progn
			    (vlax-release-object x)
			    (setq x nil)
			    )
			  )
			)
		      )
		    )
	  )
	)
      )
    (list  sourceRange TargetSht TargetWbk SourceWbk TargetShts TargetSht Sht Wbk ExcelApp)
    )
  (gc)
  (gc)
  (gc)
  (princ)
  
  )
0 Likes
Message 13 of 13

edsaqueteAG5Q7
Enthusiast
Enthusiast
It's working, thank you
0 Likes