麻辣家族討論版版 » Excel程式區 » 插入圖片時，等比例放大或縮小

返回列表下一主題上一主題發帖

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

　暱稱: 鹹蛋

中學生 Rank: 2

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

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2020-9-25 10:44 | 只看該作者

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

請教插入圖片到儲存格範圍時，如何等比例的在儲存格範圍內放大或縮小
以下程式碼為圖片大小符合儲存格，應如何修改呢？

i = ThisWorkbook.Path & "\" & NewRef & ".jpg"
X = Dir(ThisWorkbook.Path & "\" & NewRef & ".jpg")
   If X <> "" Then
      Set rngs = Range(Cells(61, 2), Cells(61, 19))
      ActiveSheet.Shapes.AddPicture i, True, True, rngs.Left, rngs.Top, rngs.Width, rngs.Height
   Else
   End If

謝謝~~

樓主熱帖

收藏

中學生 Rank: 2

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 16
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2024-3-28

2016猴年全勤獎章

2^#

發表於 2020-9-26 09:40 | 只看該作者

建議增加宣告:

Dim NewPicture as Object

複製代碼

i = ThisWorkbook.Path & "\" & NewRef & ".jpg"
X = Dir(ThisWorkbook.Path & "\" & NewRef & ".jpg")
If X <> "" Then
Set Rngs = Range(Cells(61, 2), Cells(61, 19))
Set NewPicture = ActiveSheet.Pictures.Insert(i)
With NewPicture
.ShapeRange.LockAspectRatio = msoTrue
.Left = Rngs.Left
.Height = Rngs.Height
If .Width > Rng.Width Then
.Width = Rng.Width
.Top = Rngs.Top + (Rngs.Height - .Height) / 2
Else
.Top = Rngs.Top
End If
End With

複製代碼

　暱稱: 鹹蛋

中學生 Rank: 2

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

3^#

發表於 2020-9-28 13:20 | 只看該作者

回復 2# ikboy

感謝ikboy大大回覆，
經測試後發現圖片有在儲存格內等比例放大，但似乎會停在10~15的這個迴圈出不來(因為等比例放大後的圖片寬度還是比儲存格範圍小)，
我試著在第13行插入Exit Sub，也沒有用，請問該如何修正？
另外要加上什麼指令可以將等比例放大後的圖片在儲存格範圍內置中呢？
謝謝~~

中學生 Rank: 2

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 16
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2024-3-28

2016猴年全勤獎章

4^#

發表於 2020-9-28 17:17 | 只看該作者

我是基於你的代碼修改, 未參與迴圈部份, 不曉得問題所在。

中學生 Rank: 2

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 16
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2024-3-28

2016猴年全勤獎章

5^#

發表於 2020-9-29 09:51 | 只看該作者

再看這一句 (因為等比例放大後的圖片寬度還是比儲存格範圍小) 後, 眼睛馬上@@, 腦裡??亂飛, 到底你要圖片剛填滿儲存格或圖自身長寬按相同比例盡量放入儲存格中?

　暱稱: 鹹蛋

中學生 Rank: 2

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

6^#

發表於 2020-9-29 15:17 | 只看該作者

本帖最後由 takeshilin88 於 2020-9-29 15:21 編輯

回復 5# ikboy

ikboy大大您好：

是「圖自身長寬按相同比例盡量放入儲存格中」
您提供的指令有將圖片放大，但因為儲存格範圍比較寬，所以圖片還需要左右置中
謝謝

中學生 Rank: 2

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 16
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2024-3-28

2016猴年全勤獎章

7^#

發表於 2020-9-30 10:07 | 只看該作者

由於衹是代碼片段修正案, 無法測試, 上次代碼中的Rngs, 欠了"s" 及沒有 End if, 此次一同修正。

i = ThisWorkbook.Path & "\" & NewRef & ".jpg"
X = Dir(ThisWorkbook.Path & "\" & NewRef & ".jpg")
If X <> "" Then
Set Rngs = Range(Cells(61, 2), Cells(61, 19))
Set NewPicture = ActiveSheet.Pictures.Insert(i)
With NewPicture
.ShapeRange.LockAspectRatio = msoTrue
If .Height / .Width >= Rngs.Height / Rngs.Width Then
.Height = Rngs.Height
.Top = Rngs.Top
.Left = (Rngs.Width - .Width) / 2 + Rngs.Left
Else
.Width = Rngs.Width
.Left = Rngs.Left
.Top = (Rngs.Height - .Height) / 2 + Rngs.Top
End If
End With
End If

複製代碼

　暱稱: 鹹蛋

中學生 Rank: 2

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

8^#

發表於 2020-9-30 15:07 | 只看該作者

回復 7# ikboy

感謝ikboy大大，
已經成功了，
請教這裡的If的判斷是依照什麼條件，有點不太理解?? 高 / 寬
If .Height / .Width >= Rngs.Height / Rngs.Width Then

感恩~~

中學生 Rank: 2

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 16
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2024-3-28

2016猴年全勤獎章

9^#

發表於 2020-9-30 22:44 | 只看該作者

那是計算儲存格與圖片高寬比, 選出適合的高或寬作為圖片的基礎然後......

　暱稱: 鹹蛋

中學生 Rank: 2

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

10^#

發表於 2020-10-5 15:34 | 只看該作者

回復 9# ikboy

原來如此，又學到了一招，再次感謝~~

靜思自在 : 每天無所事事，是人生的消費者，積極、有用才是人生的創造者。

返回列表下一主題上一主題