插入圖片按比例適配單元格

wubwu 2020-05-26

展開全文

我找到了一個解決辦法！
以前在Excel2003中用picture.insert方法寫的代碼，到了Excel2010中只能插入鏈接，圖片不能隨文件一起保存，不得不改為shapes.addpicture, 也同樣遇到上面所說的圖片寬高比例的問題。經(jīng)過一悉研究，好像找到了完美的方法，請各位指正。
-----------------------------------------
Shapes.AddPicture 最后兩個參數(shù)用-1,-1表示按圖片原始尺寸插入
ActiveSheet.Shapes(ActiveSheet.Shapes.Count)可以引用剛插入的圖片，從而可以讀取圖片寬和高，以及進行縮放。

例：
假如圖片所在路徑為 PicPath,要插入單元格為A1,即Cells(1,1),若要插入的圖片自動適應(yīng)A1單元格，并且保持寬高比，可用以下代碼：


With Cells(1, 1)
   PicL = .Left + .Width * 0.05
   PicT = .Top + .Height * 0.05
   PicW = .Width * 0.9
   PicH = .Height * 0.9
End With

With ActiveSheet.Shapes.AddPicture(PicPath, True, True, 0, 0, -1, -1)
End With

Set shp = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
rh = PicH / shp.Height
rw = PicW / shp.Width
r = IIf(rw > rh, rh, rw)
shp.Left = PicL
shp.Top = PicT
shp.ScaleWidth r, msoFalse, msoScaleFromTopLeft
--------------------------------------
如果配上循環(huán)語句，可以批量插入圖片。