123
返回列表 上一主題 發帖

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

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-25 
21# 跳轉到 »
發表於 2020-10-12 10:55 | 只看該作者
回復 20# takeshilin88


.LockAspectRatio = msoTrue
或
.shaperange.LockAspectRatio = msoTrue


再不行的話, 要有檔案才能了解問題何在

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-25 
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

TOP

takeshilin88
　暱稱: 鹹蛋

中學生Rank: 2

帖子
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)

TOP

takeshilin88
　暱稱: 鹹蛋

中學生Rank: 2

帖子
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)

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-25 
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

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

TOP

takeshilin88
　暱稱: 鹹蛋

中學生Rank: 2

帖子
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"
   
    都會出現"找不到指定名稱的項目。

TOP

takeshilin88
　暱稱: 鹹蛋

中學生Rank: 2

帖子
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)
    就可以了耶~~
    感謝准大，太感謝了~~

TOP

        靜思自在 : 【停滯不前，終無所得】人都迷於尋找奇蹟，因而停滯不前；縱使時間再多、路再長，也了無用處，終無所得。
123
返回列表 上一主題