插入圖片時，等比例放大或縮小

　暱稱: 鹹蛋

帖子: 62
主題: 13
精華: 0
積分: 109
點名: 0
作業系統: Win 10家用版
軟體版本: Office 2013
閱讀權限: 20
性別: 女
來自: 新北
註冊時間: 2016-1-27
最後登錄: 2024-8-12

27^#

發表於 2020-10-12 17:16 | 只看該作者

回復 25# 准提部林

剛剛試一下，把With ActiveSheet.Shapes("圖片 1")改成With ActiveSheet.Shapes.AddPicture(i, False, True, rngs.Left, rngs.Top, True, True)
就可以了耶~~
感謝准大，太感謝了~~

　暱稱: 鹹蛋

帖子: 62
主題: 13
精華: 0
積分: 109
點名: 0
作業系統: Win 10家用版
軟體版本: Office 2013
閱讀權限: 20
性別: 女
來自: 新北
註冊時間: 2016-1-27
最後登錄: 2024-8-12

26^#

發表於 2020-10-12 16:33 | 只看該作者

回復 25# 准提部林

With ActiveSheet.Shapes("圖片 1")
或設定為With ActiveSheet.Shapes(i)
我在前面設定了
i = ThisWorkbook.Path & "\" & NewRef & ".jpg"

都會出現"找不到指定名稱的項目。

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2839
主題: 10
精華: 0
積分: 2895
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-12-22

25^#

發表於 2020-10-12 14:37 | 只看該作者

本帖最後由准提部林於 2020-10-12 15:19 編輯

回復 24# takeshilin88

試了如圖:

Sub test()
Dim rngs As Range
Set rngs = [B61:S61]
With ActiveSheet.Shapes("圖片 1")
   .LockAspectRatio = True
   If .Width >= .Height Then .Width = rngs.Width - 4
   If .Height >= .Width Then .Height = rngs.Height - 4
   If .Width > rngs.Width - 4 Then .Width = rngs.Width - 4
   If .Height > rngs.Height - 4 Then .Height = rngs.Height - 4
   .Left = rngs.Left + (rngs.Width - .Width) / 2
   .Top = rngs.Top + (rngs.Height - .Height) / 2
End With
End Sub

'===============

　暱稱: 鹹蛋

帖子: 62
主題: 13
精華: 0
積分: 109
點名: 0
作業系統: Win 10家用版
軟體版本: Office 2013
閱讀權限: 20
性別: 女
來自: 新北
註冊時間: 2016-1-27
最後登錄: 2024-8-12

24^#

發表於 2020-10-12 13:33 | 只看該作者

回復准提部林

准大您好，
因需要圖片放到儲存格範圍後能做到如下：
1.圖片在儲存格範 ...
takeshilin88 發表於 2020-10-12 13:10

抱歉，更正一下檔案~~

1091012-QUO.rar (48.04 KB)

　暱稱: 鹹蛋

帖子: 62
主題: 13
精華: 0
積分: 109
點名: 0
作業系統: Win 10家用版
軟體版本: Office 2013
閱讀權限: 20
性別: 女
來自: 新北
註冊時間: 2016-1-27
最後登錄: 2024-8-12

23^#

發表於 2020-10-12 13:10 | 只看該作者

回復 22# 准提部林

准大您好，
因需要圖片放到儲存格範圍後能做到如下：
1.圖片在儲存格範圍內「等比例」的放大or縮小，也就是接近儲存格範圍的大小(但不超出儲存格範圍)
2.圖片在儲存格範圍內上下左右置中
依照您的建議還是無法達成需求，已附上檔案，謝謝~~

1091012-QUO.rar (23.15 KB)

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2839
主題: 10
精華: 0
積分: 2895
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-12-22

22^#

發表於 2020-10-12 10:58 | 只看該作者

回復 20# takeshilin88

或者, 原圖比存放位置小, 變成要"放大":
Set rngs = Range(Cells(61, 2), Cells(61, 19))
With ActiveSheet.Shapes.AddPicture(i, False, True, rngs.Left, rngs.Top, True, True)
   .LockAspectRatio = msoFalse
   .Width = rngs.Width - 4
   .Height = rngs.Height - 4
   .Left = rngs.Left + (rngs.Width - .Width) / 2
   .Top = rngs.Top + (rngs.Height - .Height) / 2
End With