Lisp向excel注入vba代码

admin1

Lisp向excel注入vba代码



(defun $excel-add-vba$
       (xlapp sh-n VBA-STR run-str lst / item vbproject xlsheet)
                    ;向excel里面写vba代码，注入vba代码
;;;  ($excel-add-vba$
;;;  xlapp
;;;  "Sub Lisp_vba()\nMsgBox \"Hello world!\", vbOKOnly, \"Lisp调用Excel\"\nEnd Sub"
;;;  "(vlax-invoke-method XLAPP (QUOTE RUN) \"Sheet1.Lisp_vba\")"
;;;  "Sheet1"
;;;  nil
;;; )
  (or xlapp (setq xlapp ($xlapp-New$ nil nil nil)))
  (setq    xlsheet
     (vl-catch-all-apply
       'vlax-get-property
       (list (vl-catch-all-apply
           'vlax-get-property
           (list (vl-catch-all-apply
               'vlax-get-property
               (list xlapp 'activeworkbook)
             )
             'Sheets
           )
         )
         'Item
         sh-n
       )
     )
  )
  (setq    VBProject
     (vl-catch-all-apply
       'vlax-get-property
       (list
         (vl-catch-all-apply
           'vlax-get-property
           (list xlapp
             "ActiveWorkbook"
           )
         )
         'VBProject
       )
     )
  )
  (setq    Item (vl-catch-all-apply
           'vlax-invoke-method
           (LIST
         (vl-catch-all-apply
           'vlax-get-property
           (LIST
             VBProject
             'VBComponents
           )
         )
         'Item
         sh-n
           )
         )
  )
  (vl-catch-all-apply
    'vlax-invoke-method
    (LIST
      (vl-catch-all-apply
    'vlax-get-property
    (LIST
      Item
      'CodeModule
    )
      )
      'DeleteLines
      1
      (vl-catch-all-apply
    'vlax-get-property
    (LIST
      (vl-catch-all-apply
        'vlax-get-property
        (LIST
          Item
          'CodeModule
        )
      )
      'CountOfLines
    )
      )
    )
  )                    ;删除历史的vba代码
  (vl-catch-all-apply
    'vlax-invoke-method
    (LIST
      (vl-catch-all-apply
    'vlax-get-property
    (LIST
      Item
      'CodeModule
    )
      )
      'AddFromString
      VBA-STR
    )
  )
  (vl-catch-all-apply
    'EVAL
    (list (vl-catch-all-apply 'READ (list run-str)))
  )
  (vl-catch-all-apply
    'vlax-get-property
    (LIST
      (vl-catch-all-apply
    'vlax-get-property
    (LIST
      Item
      'CodeModule
    )
      )
      'CountOfLines
    )
  )                    ;返回写入成功的行数
)