Lisp保存excel工作薄

admin1

Lisp保存excel工作薄



(Defun vlxls-app-saveas
       (xlapp Filename quit? lst / Rtn save kzm wjm f wb)
                    ;保存工作薄
  (if (and xlapp
       (setq wb (vl-catch-all-apply
              'vlax-get-property
              (list xlapp 'activeworkbook)
            )
       )
       (not (vl-catch-all-error-p wb))
      )
    ()
    (setq xlapp    (vl-catch-all-apply
          (function (lambda () ($xlapp-New$ 0 t nil)))
        )
    )
  )
  (setq    wb (vl-catch-all-apply
         'vlax-get-property
         (list xlapp 'activeworkbook)
       )
  )
  (OR (and Filename
       (setq kzm (vl-filename-extension Filename))
       (wcmatch kzm "[,*.xls,*.XLS,]")
      )                    ;扩展名
      (SETQ KZM ".xls")
  )
  (or (and Filename
       (setq wjm (vl-filename-base Filename))
       (> (strlen wjm) 0)
      )
      (setq wjm "data")
  )
  (or (and Filename
       (setq f (vl-filename-directory Filename))
       (setq f (vl-string-right-trim "\\" f))
      )
      (and (setq f (getvar "dwgprefix"))
       (setq f (vl-string-right-trim "\\" f))
      )
  )
  (setq Filename (strcat f "\\" wjm kzm))
  (vl-catch-all-apply
    'vlax-put-property
    (LIST xlapp 'DisplayAlerts :vlax-False)
  )                    ;保存的时候不弹出警告的窗口  
  (setq    save (vl-catch-all-apply
           (function (lambda ()
               (vlax-invoke-method
                 wb          "SaveAs"     Filename
                 msxlc-xlNormal           ""
                 ""          :vlax-False  :vlax-False
                 nil
                )
             )
           )
         )
  )
  (if (vl-catch-all-error-p save)
    (progn (setq save nil)
       (setq Filename (vl-filename-mktemp Filename))
       (setq save (vl-catch-all-apply
            (function (lambda ()
                    (vlax-invoke-method
                      wb       "SaveAs"
                      Filename       msxlc-xlNormal
                      ""       ""
                      :vlax-False  :vlax-False
                      nil
                     )
                  )
            )
              )
       )
    )
  )
  (if quit?
    (progn
      (vlax-invoke-method
    (vlax-get-property xlapp 'activeworkbook)
    'Close
      )
      (vlax-invoke-method xlapp 'Quit)
    )
  )
  (if (vl-catch-all-error-p save)
    nil
    (findfile Filename)
  )
)