[問題] Excel VBA 圖片放大縮小

看板Office作者foxsqk (狐狸)時間9年前 (2017/04/28 10:23)推噓1(1推 0噓 2→)

留言3則, 2人參與討論串1/1

(若是和其他不同軟體互動之問題請記得一併填寫) 軟體: office excel 版本:2016 因為在學習VBA 所以有搜尋到這個圖片放大縮小的程式碼, 想要問一下,為什麼我將這個程式碼貼到其他地方不能用想要貼到其他練習試做一下,但是怎樣都無法成功目前只有將圖片縮小有成功,不過放大圖片都失敗圖片名稱有改picture 1 巨集也有打開＜範例檔＞下載：檔案名稱：20140723a01(點按圖片縮放大小).rar 下載連結：http://www.funp.net/981048 附上VBA程式碼 Dim Pic As Object, xR As Range Sub 重設全部圖片() '必須先執行此程式，才能產生點按圖片縮放大小功能 For Each Pic In ActiveSheet.Pictures Pic.OnAction = "圖片放大縮小" '將圖片指定同一個巨集 Call 縮圖 Next End Sub Sub 圖片放大縮小() Dim Per Set Pic = ActiveSheet.Shapes(Application.Caller) '取得點按巨集圖片物件 Set xR = Pic.TopLeftCell.MergeArea '取得圖片位置儲存格區 If Pic.Height > xR.Height Or Pic.Width > xR.Width Then '圖片超出儲存格時,縮小之 Call 縮圖 Else '否則放大圖片 Per = 1 '圖片放大比率(1=100%，0.8則為80%) With Pic .LockAspectRatio = True '保持長寬比率 .ZOrder msoBringToFront '最上層顯示，避免被其它物件遮蓋 .ScaleHeight Per, True '高度比率 .ScaleWidth Per, True '寬度比率 End With End If End Sub Sub 縮圖() Set xR = Pic.TopLeftCell.MergeArea '取得圖片位置儲存格區 Pic.Height = xR.Height - 6 Pic.Width = xR.Width - 6 Pic.Top = xR.Top + 3 Pic.Left = xR.Left + 3 End Sub -- ※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 122.146.88.216 ※ 文章網址: https://www.ptt.cc/bbs/Office/M.1493346186.A.71D.html