晴空O_o 发表于 2022-8-8 21:11:08

excel插入图片-无法正常运行

(defun excel-inspic (xlappsh-n   ID    path
             xlapprelease   LST    /
             HH1   L    Mergerange
             PPic   Picnamesc
             ShapeRange   W    W1
             xlrangexlsheet
            )
          ;插入图片
          ;xlapp excel对象
          ;sh-n sheet表名
          ;id 单元格
          ;path 图片路径
          ;xlapprelease 程序结束后是否需要释放excel?
          ;lst 预留参数
(setqxlsheet sh-n);(vlax-get-property (vlax-get-property (vlax-get-property xlapp 'activeworkbook) 'Sheets) 'Item sh-n))
(setqPic (vlax-invoke-method (vlax-invoke-method xlsheet 'Pictures) 'Insert path))
(setqPicname (vlax-get-property Pic 'Name))
(setqW1 (vlax-get-property Pic 'Width))
(setqH1 (vlax-get-property Pic 'Height))
(setqxlrange (vlax-get-property (vlax-get (vlax-get-property xlapp "ActiveWorkbook") 'ActiveSheet) 'range id))
(setqL (vlax-variant-value (vlax-get-property xlrange 'Left)))
(SETQP (vlax-variant-value (vlax-get-property xlrange 'Top)))
(SETQW (vlax-variant-value (vlax-get-property xlrange 'Width)))
(SETQH (vlax-variant-value (vlax-get-property xlrange 'Height)))
(vlax-put-property Pic 'Left L)
(vlax-put-property Pic 'Top P)
(setqShapeRange (vlax-get-property (vlax-get-property xlsheet 'Shapes) 'Range Picname))
(vlax-put-property ShapeRange 'LockAspectRatio)
(if (AND W
   (NOT (VL-CATCH-ALL-ERROR-P W))
   W1
   (NOT (VL-CATCH-ALL-ERROR-P W1))
   H1
   (NOT (VL-CATCH-ALL-ERROR-P H1))
   H
   (NOT (VL-CATCH-ALL-ERROR-P H))
      )
    (if(>= (/ W H) (/ W1 H1))
      (progn
(SETQ SC (/ (- W (* (/ W1 H1) H)) 2))
(vlax-put-property ShapeRange 'Height H)
(vlax-invoke-method ShapeRange 'IncrementLeft SC)
      )
      (progn
(SETQ SC (/ (- H (* (/ H1 W1) W)) 2))
(vlax-put-property ShapeRange 'Width W)
(vlax-invoke-method ShapeRange 'IncrementTop SC)
      )
    )
(vlax-put-property Pic 'Placement (vlax-make-variant 1 2))
)
(princ)
)
代码是在论坛找的 ，相关ActiveX方法实在是找不到说明 帮助文件里没有，求大神答疑解惑

自贡黄明儒 发表于 2022-8-8 21:55:08

可以在excel录制宏来参考

晴空O_o 发表于 2022-8-9 08:42:28

自贡黄明儒 发表于 2022-8-8 21:55
可以在excel录制宏来参考

谢了 黄总 真不容易啊

晴空O_o 发表于 2022-8-9 10:53:55

自贡黄明儒 发表于 2022-8-8 21:55
可以在excel录制宏来参考

黄总 能再详细指导一下嘛 有点抓瞎

渠辉 发表于 2022-8-10 16:46:46

(setq xlrange (vlax-get-property
               (setq xlsheet (vlax-get (vlax-get-property xlapp "activeworkbook")
                                       'activesheet
                             )
               )
               'range
               "C40"
             )
)
(setq pic (vlax-invoke
          (vlax-invoke xlsheet 'pictures)
          'insert
          "d:\\122.bmp"
          )
)

渠辉 发表于 2022-8-11 07:08:08

;; (excel-inspic (vlax-get xlapp 'activesheet)"A1" "D:\\122.bmp")
(defun excel-inspic (sht id path / h h1        l p pic        picname        sc shaperange w        w1 xlrang)
(setq xlrange (vlax-get-property sht 'range id))
(setq        pic (vlax-invoke
              (vlax-invoke sht 'pictures)
              'insert
              path
          )
)
(setq picname (vlax-get-property pic 'name))
(setq w1 (vlax-get-property pic 'width))
(setq h1 (vlax-get-property pic 'height))

(setq l (vlax-variant-value (vlax-get-property xlrange 'left)))
(setq p (vlax-variant-value (vlax-get-property xlrange 'top)))
(setq w (vlax-variant-value (vlax-get-property xlrange 'width)))
(setq h (vlax-variant-value (vlax-get-property xlrange 'height)))
(vlax-put-property pic 'left l)
(vlax-put-property pic 'top p)
(setq        shaperange (vlax-get-property
                     (vlax-get-property sht 'shapes)
                     'range
                     picname
                   )
)

(if (>= (/ w h) (/ w1 h1))
    (progn
      (setq sc (/ (- w (* (/ w1 h1) h)) 2))
      (vlax-put-property shaperange 'height h)
      (vlax-invoke shaperange 'incrementleft sc)
    )
    (progn
      (setq sc (/ (- h (* (/ h1 w1) w)) 2))
      (vlax-put-property shaperange 'width w)
      (vlax-invoke shaperange 'incrementtop sc)
    )
)
(princ)
)

libo2000 发表于 2023-6-24 03:25:37

path如何修改为插入剪贴板内的图像?

libo2000 发表于 2023-6-24 17:05:25

Excel插入图片后，是链接类型的图片，一旦删除图片就没法显示了。如何插入时直接粘贴到excel内，而不是链接？
页: [1]
查看完整版本: excel插入图片-无法正常运行