转一个意大利人弄的代码

菜卷鱼 · 发表于 2016-3-23 12:33:09

程序很屌，可惜不支持中文，哪位大神优化一下
http://www.redchar.net/?x=entry:entry160125-131940
点这里进入源网址

; FODS Writer
; Versione : 1.1.1
; Autore : Roberto Rossi
; Web : http://www.redchar.net
;
; questa libreria di funzioni consente la scrittura di un file FODS
;
; il funzionamento ?semplicissimo e consta di 3 passaggi:
; - prima di tutto occorre creare il documento
; - poi si possono aggiungere le singole celle
; - infine si pu?salvare
;
(setq FODS-FILE-HEADER
"<?xml version=\"1.0\" encoding=\"utf-8\"?>
<office:document xmlns:office=\"urn:oasis:names:tc:opendocument:xmlns:office:1.0\"
xmlns:style=\"urn:oasis:names:tc:opendocument:xmlns:style:1.0\"
xmlns:text=\"urn:oasis:names:tc:opendocument:xmlns:text:1.0\"
xmlns:table=\"urn:oasis:names:tc:opendocument:xmlns:table:1.0\"
xmlns:draw=\"urn:oasis:names:tc:opendocument:xmlns:drawing:1.0\"
xmlns:fo=\"urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0\"
xmlns:xlink=\"http://www.w3.org/1999/xlink\"
xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
xmlns:meta=\"urn:oasis:names:tc:opendocument:xmlns:meta:1.0\"
xmlns:number=\"urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0\"
xmlns:presentation=\"urn:oasis:names:tc:opendocument:xmlns:presentation:1.0\"
xmlns:svg=\"urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0\"
xmlns:chart=\"urn:oasis:names:tc:opendocument:xmlns:chart:1.0\"
xmlns:dr3d=\"urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0\"
xmlns:math=\"http://www.w3.org/1998/Math/MathML\"
xmlns:form=\"urn:oasis:names:tc:opendocument:xmlns:form:1.0\"
xmlns:script=\"urn:oasis:names:tc:opendocument:xmlns:script:1.0\"
xmlns:config=\"urn:oasis:names:tc:opendocument:xmlns:config:1.0\"
xmlns:ooo=\"http://openoffice.org/2004/office\"
xmlns:ooow=\"http://openoffice.org/2004/writer\"
xmlns:oooc=\"http://openoffice.org/2004/calc\"
xmlns:dom=\"http://www.w3.org/2001/xml-events\"
xmlns:xforms=\"http://www.w3.org/2002/xforms\"
xmlns:xsd=\"http://www.w3.org/2001/XMLSchema\"
xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"
xmlns:rpt=\"http://openoffice.org/2005/report\"
xmlns:of=\"urn:oasis:names:tc:opendocument:xmlns:of:1.2\"
xmlns:xhtml=\"http://www.w3.org/1999/xhtml\"
xmlns:grddl=\"http://www.w3.org/2003/g/data-view#\"
xmlns:tableooo=\"http://openoffice.org/2009/table\"
xmlns:drawooo=\"http://openoffice.org/2010/draw\"
xmlns:calcext=\"urn:org:documentfoundation:names:experimental:calc:xmlns:calcext:1.0\"
xmlns:loext=\"urn:org:documentfoundation:names:experimental:office:xmlns:loext:1.0\"
xmlns:field=\"urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field:1.0\"
xmlns:formx=\"urn:openoffice:names:experimental:ooxml-odf-interop:xmlns:form:1.0\"
xmlns:css3t=\"http://www.w3.org/TR/css3-text/\" office:version=\"1.2\"
office:mimetype=\"application/vnd.oasis.opendocument.spreadsheet\">")
;funzione che ritorna il contenuto di una cella函数返回一个单元格的内容
(defun FODSGetCellValue (objDoc sheetName row column / result lstdef typeVal)
(if (= (type row) 'INT)
(setq row (itoa row))
)
(setq column (strcase column))
(setq typeVal (strcat "cell=" row ":" column "\t" sheetName))
(setq result (assoc typeVal objDoc))
(if result
(progn
(setq result (cadr result))
)
)
result
)
;funzione che rigorna la lettera pi?alta usata per un dato Sheet
(defun FODSGetMaxColumn (objDoc sheet / result typeVal lstdef sheetName r initSheet)
(setq result 0)
(foreach lstdef objDoc
(setq typeVal (car lstdef))
(if (= (substr typeVal 1 5) "cell=")
(progn
(setq sheetName (substr typeVal (+ 2 (vl-string-search "\t" typeVal))))
(if (= sheet sheetName)
(progn
(setq initSheet (vl-string-search ":" typeVal))
(setq r (substr typeVal (+ 2 initSheet) (- (vl-string-search "\t" typeVal) (1+ initSheet))))
(if (> (ascii r) result)
(setq result (ascii r))
)
)
)
)
)
)
result
)
;funzione che ritorna il numero di riga pi?alto usato per un dato Sheet
(defun FODSGetMaxRow (objDoc sheet / result typeVal lstdef sheetName r)
(setq result 0)
(foreach lstdef objDoc
(setq typeVal (car lstdef))
(if (= (substr typeVal 1 5) "cell=")
(progn
(setq sheetName (substr typeVal (+ 2 (vl-string-search "\t" typeVal))))
(if (= sheet sheetName)
(progn
(setq r (substr typeVal 6 (- (vl-string-search ":" typeVal) 5)))
(if (> (atoi r) result)
(setq result (atoi r))
)
)
)
)
)
)
result
)
;ritorna l'elenco dei fogli definiti返回列表的表定义
(defun FODSGetSheets (objDoc / result lstdef typeVal tp sheetName)
(foreach lstdef objDoc
(setq typeVal (car lstdef))
(if (= (substr typeVal 1 5) "cell=")
(progn
(setq sheetName (substr typeVal (+ 2 (vl-string-search "\t" typeVal))))
(if (not (member sheetName result))
(setq result (cons sheetName result))
)
)
)
)
(reverse result)
)
;crea un oggetto/lista per i file FODS创建一个对象文件fods /列表
(defun FODSNew ( / result)
(list '("generator" "FODS Libryary"))
)
;aggiunge una cella a un oggetto/list FODS添加一个列表对象的一个单元/ fods
(defun FODSAddCell (objDoc sheetName row column value / typeVal lstVal search)
(if (= (type row) 'INT)
(setq row (itoa row))
)
(setq column (strcase column))
(setq typeVal (strcat "cell=" row ":" column "\t" sheetName))
(setq search (assoc typeVal objDoc))
(setq lstVal (list typeVal value))
(if search
(progn ;sostituzione vecchio valore
(subst lstVal search objDoc)
)
(progn ;nuovo valore
(reverse (cons lstVal (reverse objDoc)))
)
)
)
;scrive un file FODS写一个文件fods
(defun FODSWrite (objDoc fileName / sheetsList sheet maxCol maxRow lstVal result c r value idf)
;TODO : apertura file
(setq idf (open fileName "w"))
(if idf
(progn
(write-line FODS-FILE-HEADER idf)
(write-line "<office:meta>" idf)
(write-line (strcat "<meta:generator>"
(cadr (assoc "generator" objDoc))
"</meta:generator>") idf)
(write-line "</office:meta>" idf)
(write-line "<office:body>" idf)
(write-line "<office:spreadsheet>" idf)
(setq sheetsList (FODSGetSheets objDoc))
(foreach sheet sheetsList
;inizio Sheet
(write-line (strcat "<table:table table:name=\"" sheet "\">") idf)
(setq maxCol (FODSGetMaxColumn objDoc sheet))
(setq maxRow (FODSGetMaxRow objDoc sheet))
(setq r 1)
;numero colonne
(write-line (strcat "<table:table-column table:number-columns-repeated=\""
(itoa (- maxCol 64))
"\"/>"
)
idf)
(while (<= r maxRow)
;inizio riga
(write-line "<table:table-row>" idf)
(setq c 65) ;A
(while (<= c maxCol)
(setq value (FODSGetCellValue objDoc sheet r (chr c)))
;inserimento linea vuota o piena
(if value
(progn
(setq value (vl-string-subst "<" "<" value))
(setq value (vl-string-subst ">" ">" value))
(write-line "<table:table-cell office:value-type=\"string\" calcext:value-type=\"string\">" idf)
(write-line (strcat "<text:p>" value "</text:p>") idf)
(write-line "</table:table-cell>" idf)
)
(progn
(write-line "<table:table-cell/>" idf)
)
)
(setq c (1+ c))
)
(setq r (1+ r))
;fine riga
(write-line "</table:table-row>" idf)
)
;fine Sheet
(write-line "</table:table>" idf)
)
(write-line "</office:spreadsheet>" idf)
(write-line "</office:body>" idf)
(write-line "</office:document>" idf)
(close idf)
);endp
);Endif
result
)
;funzione di test
(defun FODSTest ( / )
(setq objDoc (FODSNew))
;(print objDoc)
(setq objDoc (FODSAddCell objDoc "Sheet1" "1" "A" "cioa ciao"))
(setq objDoc (FODSAddCell objDoc "Sheet1" "2" "A" "uella <A>"))
(setq objDoc (FODSAddCell objDoc "Sheet1" "2" "c" "uella <2c>"))
(setq objDoc (FODSAddCell objDoc "Sheet1" 3 "b" "essere o non essere1"))
(setq objDoc (FODSAddCell objDoc "Sheet1" 2 "a" "sostituito"))
(setq objDoc (FODSAddCell objDoc "Sheet1" 15 "b" "essere o non essere2"))
(setq objDoc (FODSAddCell objDoc "Sheet2" 3 "b" "essere o non essere3"))
(setq objDoc (FODSAddCell objDoc "Sheet2" 2 "a" "il mio valore"))
(setq objDoc (FODSAddCell objDoc "Sheet3" 7 "a" "valore X"))
(setq objDoc (FODSAddCell objDoc "Sheet3" 3 "f" "valore X2"))
;(print objDoc)
;(print (FODSGetSheets objDoc))
;(print (FODSGetMaxRow objDoc "Sheet3"))
;(print (chr (FODSGetMaxColumn objDoc "Sheet3")))
;(print (FODSGetCellValue objDoc "Sheet1" 2 "A"))
(FODSWrite objDoc "c:\\temp\\test2.fods")
(alert "procedura termianta")
(prin1)
)
;(FODSTest)

; FODS Writer 
; Versione : 1.1.1 
; Autore : Roberto Rossi 
; Web : <a href="http://www.redchar.net" target="_blank">http://www.redchar.net</a> 
; 
; questa libreria di funzioni consente la scrittura di un file FODS 
; 
; il funzionamento ?semplicissimo e consta di 3 passaggi: 
; - prima di tutto occorre creare il documento 
; - poi si possono aggiungere le singole celle 
; - infine si pu?salvare 
; 
 
(setq FODS-FILE-HEADER 
"<?xml version=\"1.0\" encoding=\"utf-8\"?> 
<office:document xmlns:office=\"urn:oasis:names:tc:opendocument:xmlns:office:1.0\" 
xmlns:style=\"urn:oasis:names:tc:opendocument:xmlns:style:1.0\" 
xmlns:text=\"urn:oasis:names:tc:opendocument:xmlns:text:1.0\" 
xmlns:table=\"urn:oasis:names:tc:opendocument:xmlns:table:1.0\" 
xmlns:draw=\"urn:oasis:names:tc:opendocument:xmlns:drawing:1.0\" 
xmlns:fo=\"urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0\" 
xmlns:xlink=\"http://www.w3.org/1999/xlink\" 
xmlns:dc=\"http://purl.org/dc/elements/1.1/\" 
xmlns:meta=\"urn:oasis:names:tc:opendocument:xmlns:meta:1.0\" 
xmlns:number=\"urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0\" 
xmlns:presentation=\"urn:oasis:names:tc:opendocument:xmlns:presentation:1.0\" 
xmlns:svg=\"urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0\" 
xmlns:chart=\"urn:oasis:names:tc:opendocument:xmlns:chart:1.0\" 
xmlns:dr3d=\"urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0\" 
xmlns:math=\"http://www.w3.org/1998/Math/MathML\" 
xmlns:form=\"urn:oasis:names:tc:opendocument:xmlns:form:1.0\" 
xmlns:script=\"urn:oasis:names:tc:opendocument:xmlns:script:1.0\" 
xmlns:config=\"urn:oasis:names:tc:opendocument:xmlns:config:1.0\" 
xmlns:ooo=\"http://openoffice.org/2004/office\" 
xmlns:ooow=\"http://openoffice.org/2004/writer\" 
xmlns:oooc=\"http://openoffice.org/2004/calc\" 
xmlns:dom=\"http://www.w3.org/2001/xml-events\" 
xmlns:xforms=\"http://www.w3.org/2002/xforms\" 
xmlns:xsd=\"http://www.w3.org/2001/XMLSchema\" 
xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" 
xmlns:rpt=\"http://openoffice.org/2005/report\" 
xmlns:of=\"urn:oasis:names:tc:opendocument:xmlns:of:1.2\" 
xmlns:xhtml=\"http://www.w3.org/1999/xhtml\" 
xmlns:grddl=\"http://www.w3.org/2003/g/data-view#\" 
xmlns:tableooo=\"http://openoffice.org/2009/table\" 
xmlns:drawooo=\"http://openoffice.org/2010/draw\" 
xmlns:calcext=\"urn:org:documentfoundation:names:experimental:calc:xmlns:calcext:1.0\" 
xmlns:loext=\"urn:org:documentfoundation:names:experimental:office:xmlns:loext:1.0\" 
xmlns:field=\"urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field:1.0\" 
xmlns:formx=\"urn:openoffice:names:experimental:ooxml-odf-interop:xmlns:form:1.0\" 
xmlns:css3t=\"http://www.w3.org/TR/css3-text/\" office:version=\"1.2\" 
office:mimetype=\"application/vnd.oasis.opendocument.spreadsheet\">") 
 
 
;funzione che ritorna il contenuto di una cella函数返回一个单元格的内容 
(defun FODSGetCellValue (objDoc sheetName row column / result lstdef typeVal) 
    (if (= (type row) 'INT) 
        (setq row (itoa row)) 
    ) 
    (setq column (strcase column)) 
    (setq typeVal (strcat "cell=" row ":" column "\t" sheetName)) 
    
    (setq result (assoc typeVal objDoc)) 
    (if result 
        (progn 
            (setq result (cadr result)) 
        ) 
    ) 
result 
) 
 
;funzione che rigorna la lettera pi?alta usata per un dato Sheet 
(defun FODSGetMaxColumn (objDoc sheet / result typeVal lstdef sheetName r initSheet) 
(setq result 0) 
    (foreach lstdef objDoc 
        (setq typeVal (car lstdef)) 
        (if (= (substr typeVal 1 5) "cell=") 
            (progn 
                (setq sheetName (substr typeVal (+ 2 (vl-string-search "\t" typeVal)))) 
                (if (= sheet sheetName) 
                    (progn 
                        (setq initSheet (vl-string-search ":" typeVal)) 
                        (setq r (substr typeVal (+ 2 initSheet) (- (vl-string-search "\t" typeVal) (1+ initSheet)))) 
                        (if (> (ascii r) result) 
                            (setq result (ascii r)) 
                        ) 
                    ) 
                ) 
            ) 
        ) 
    ) 
result 
) 
 
;funzione che ritorna il numero di riga pi?alto usato per un dato Sheet 
(defun FODSGetMaxRow (objDoc sheet / result typeVal lstdef sheetName r) 
(setq result 0) 
    (foreach lstdef objDoc 
        (setq typeVal (car lstdef)) 
        (if (= (substr typeVal 1 5) "cell=") 
            (progn 
                (setq sheetName (substr typeVal (+ 2 (vl-string-search "\t" typeVal)))) 
                (if (= sheet sheetName) 
                    (progn 
                        (setq r (substr typeVal 6 (- (vl-string-search ":" typeVal) 5))) 
                        (if (> (atoi r) result) 
                            (setq result (atoi r)) 
                        ) 
                    ) 
                ) 
            ) 
        ) 
    ) 
result 
) 
 
;ritorna l'elenco dei fogli definiti返回列表的表定义 
(defun FODSGetSheets (objDoc / result lstdef typeVal tp sheetName) 
    (foreach lstdef objDoc 
        (setq typeVal (car lstdef)) 
        (if (= (substr typeVal 1 5) "cell=") 
            (progn 
                (setq sheetName (substr typeVal (+ 2 (vl-string-search "\t" typeVal)))) 
                (if (not (member sheetName result)) 
                    (setq result (cons sheetName result)) 
                ) 
            ) 
        ) 
    ) 
    (reverse result) 
) 
 
;crea un oggetto/lista per i file FODS创建一个对象文件fods /列表 
(defun FODSNew ( / result) 
    (list '("generator" "FODS Libryary")) 
) 
 
;aggiunge una cella a un oggetto/list FODS添加一个列表对象的一个单元/ fods 
(defun FODSAddCell (objDoc sheetName row column value / typeVal lstVal search) 
    (if (= (type row) 'INT) 
        (setq row (itoa row)) 
    ) 
    (setq column (strcase column)) 
    (setq typeVal (strcat "cell=" row ":" column "\t" sheetName)) 
    
    (setq search (assoc typeVal objDoc)) 
    (setq lstVal (list typeVal value)) 
    (if search 
        (progn ;sostituzione vecchio valore 
            (subst lstVal search objDoc) 
        ) 
        (progn ;nuovo valore 
            (reverse (cons lstVal (reverse objDoc))) 
        ) 
    ) 
) 
 
;scrive un file FODS写一个文件fods 
(defun FODSWrite (objDoc fileName / sheetsList sheet maxCol maxRow lstVal result c r value idf) 
    ;TODO : apertura file 
    (setq idf (open fileName "w")) 
    (if idf 
        (progn    
            (write-line FODS-FILE-HEADER idf) 
             
            (write-line "<office:meta>" idf) 
            (write-line (strcat "<meta:generator>" 
                            (cadr (assoc "generator" objDoc)) 
                                "</meta:generator>") idf) 
            (write-line "</office:meta>" idf)                      
            (write-line "<office:body>" idf) 
            (write-line "<office:spreadsheet>" idf) 
            (setq sheetsList (FODSGetSheets objDoc)) 
            (foreach sheet sheetsList 
                ;inizio Sheet 
                (write-line (strcat "<table:table table:name=\"" sheet "\">") idf) 
                
                (setq maxCol (FODSGetMaxColumn objDoc sheet)) 
                (setq maxRow (FODSGetMaxRow objDoc sheet))         
                (setq r 1) 
                ;numero colonne 
                (write-line (strcat "<table:table-column table:number-columns-repeated=\"" 
                                    (itoa (- maxCol 64)) 
                                    "\"/>" 
                            ) 
                        idf) 
                (while (<= r maxRow) 
                    ;inizio riga 
                    (write-line "<table:table-row>" idf) 
                    (setq c 65) ;A 
                    (while (<= c maxCol) 
                        (setq value (FODSGetCellValue objDoc sheet r (chr c))) 
                        ;inserimento linea vuota o piena 
                        (if value 
                            (progn 
                                (setq value (vl-string-subst "<" "<" value)) 
                                (setq value (vl-string-subst ">" ">" value)) 
                                (write-line "<table:table-cell office:value-type=\"string\" calcext:value-type=\"string\">" idf) 
                                (write-line (strcat "<text:p>" value "</text:p>") idf) 
                                (write-line "</table:table-cell>" idf)                               
                            ) 
                            (progn 
                                (write-line "<table:table-cell/>" idf) 
                            ) 
                        ) 
                        (setq c (1+ c)) 
                    )             
                    (setq r (1+ r)) 
                    ;fine riga 
                    (write-line "</table:table-row>" idf) 
                ) 
                ;fine Sheet 
                (write-line "</table:table>" idf) 
            ) 
            (write-line "</office:spreadsheet>" idf) 
            (write-line "</office:body>" idf) 
            (write-line "</office:document>" idf) 
             
            (close idf) 
        );endp 
    );Endif 
    result 
) 
 
;funzione di test 
(defun FODSTest ( / ) 
    
    (setq objDoc (FODSNew)) 
    ;(print objDoc) 
    (setq objDoc (FODSAddCell objDoc "Sheet1" "1" "A" "cioa ciao")) 
    (setq objDoc (FODSAddCell objDoc "Sheet1" "2" "A" "uella <A>")) 
    (setq objDoc (FODSAddCell objDoc "Sheet1" "2" "c" "uella <2c>")) 
    (setq objDoc (FODSAddCell objDoc "Sheet1" 3 "b" "essere o non essere1")) 
    (setq objDoc (FODSAddCell objDoc "Sheet1" 2 "a" "sostituito")) 
    (setq objDoc (FODSAddCell objDoc "Sheet1" 15 "b" "essere o non essere2")) 
    (setq objDoc (FODSAddCell objDoc "Sheet2" 3 "b" "essere o non essere3")) 
    (setq objDoc (FODSAddCell objDoc "Sheet2" 2 "a" "il mio valore")) 
    (setq objDoc (FODSAddCell objDoc "Sheet3" 7 "a" "valore X")) 
    (setq objDoc (FODSAddCell objDoc "Sheet3" 3 "f" "valore X2")) 
 
    ;(print objDoc) 
    ;(print (FODSGetSheets objDoc)) 
    ;(print (FODSGetMaxRow objDoc "Sheet3")) 
    ;(print (chr (FODSGetMaxColumn objDoc "Sheet3"))) 
    ;(print (FODSGetCellValue objDoc "Sheet1" 2 "A")) 
    
    (FODSWrite objDoc "c:\\temp\\test2.fods") 
    (alert "procedura termianta") 
(prin1) 
) 
 
 
;(FODSTest)

yuanziyou · 发表于 2016-3-23 12:57:22

有啥功能?

菜卷鱼 · 发表于 2016-3-23 13:00:22

yuanziyou 发表于 2016-3-23 12:57
有啥功能?

直接创建fods文件，支持libreoffice的

账号		自动登录	找回密码
密码			注册

[讨论] 转一个意大利人弄的代码

相关帖子