Excel单元格插入批注

dcl1214 · 发表于 2021-7-3 10:59:40

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun $excel-dan-yuan-ge-pi-zhu$ (xlapp sh-n address-str-h lst)
;Excel单元格插入批注
;xlapp excel对象
;sh-n 表的名字
;address-str-h 三个值：单元格地址、字串、文字大小
;lst 预留参数
;($excel-dan-yuan-ge-pi-zhu$ xlapp "Sheet2"(list(list "A1" "中线CAD:\n这个列不能删除，删除后将会带来灾乱性后果")(list "B2" "秦始皇：\n您好呀，我是批注"))nil)
(defun $set-font-size$ (range h)
(vl-catch-all-apply
'vlax-put-property
(list
(vl-catch-all-apply
'vlax-get-property
(list
(vl-catch-all-apply
'vlax-invoke-method
(list
(vl-catch-all-apply
'vlax-get-property
(list
(vl-catch-all-apply
'vlax-get-property
(list
(vl-catch-all-apply
'vlax-get-property
(list range 'Comment)
)
'Shape
)
)
'TextFrame
)
)
'Characters
)
)
'font
)
)
'size
h ;文字高度
)
)
)
(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 zt (mapcar (function (lambda (a / address str h range zt)
(setq address (car a))
(setq str (cadr a))
(setq h (caddr a))
(or h (setq h 8))
(if str
(progn
(SETQ
range (vl-catch-all-apply
'msxlp-get-range
(list xlsheet address)
)
) ;单元格对象
(vl-catch-all-apply
'vlax-invoke-method
(list range 'ClearComments)
) ;删除历史批注
(setq zt (vl-catch-all-apply
'vlax-invoke-method
(list
range
'AddComment.Text
str
)
)
) ;添加批注
($set-font-size$ range h)
)
)
zt
)
)
address-str-h
)
)
zt
)

(defun $excel-dan-yuan-ge-pi-zhu$ (xlapp sh-n address-str-h lst) 
          ;Excel单元格插入批注 
          ;xlapp excel对象 
          ;sh-n 表的名字 
          ;address-str-h  三个值：单元格地址、字串、文字大小 
          ;lst 预留参数 
          ;($excel-dan-yuan-ge-pi-zhu$  xlapp  "Sheet2"(list(list "A1" "中线CAD:\n这个列不能删除，删除后将会带来灾乱性后果")(list "B2" "秦始皇：\n您好呀，我是批注"))nil) 
  (defun $set-font-size$ (range h) 
    (vl-catch-all-apply 
      'vlax-put-property 
      (list 
  (vl-catch-all-apply 
    'vlax-get-property 
    (list 
      (vl-catch-all-apply 
        'vlax-invoke-method 
        (list 
    (vl-catch-all-apply 
      'vlax-get-property 
      (list 
        (vl-catch-all-apply 
          'vlax-get-property 
          (list 
      (vl-catch-all-apply 
        'vlax-get-property 
        (list range 'Comment) 
      ) 
      'Shape 
          ) 
        ) 
        'TextFrame 
      ) 
    ) 
    'Characters 
        ) 
      ) 
      'font 
    ) 
  ) 
  'size 
  h        ;文字高度 
      ) 
    ) 
  ) 
  (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  zt (mapcar (function (lambda (a / address str h range zt) 
             (setq address (car a)) 
             (setq str (cadr a)) 
             (setq h (caddr a)) 
             (or h (setq h 8)) 
             (if str 
         (progn 
           (SETQ 
             range (vl-catch-all-apply 
               'msxlp-get-range 
               (list xlsheet address) 
             ) 
           )  ;单元格对象 
           (vl-catch-all-apply 
             'vlax-invoke-method 
             (list range 'ClearComments) 
           )  ;删除历史批注   
           (setq zt (vl-catch-all-apply 
                'vlax-invoke-method 
                (list 
            range 
            'AddComment.Text 
            str 
                ) 
              ) 
           )  ;添加批注 
           ($set-font-size$ range h) 
         ) 
             ) 
             zt 
           ) 
       ) 
       address-str-h 
     ) 
  ) 
  zt 
)

279491611 · 发表于 2021-7-3 16:13:05

楼主这几天与excel 杠上啦

Michael527 · 发表于 2021-7-5 08:06:50

Excel'工具，值得收藏，谢谢

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

[原创] Excel单元格插入批注

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。