takeshilin88

回復 7# ikboy

    求救!!!
    因此excel檔後續以巨集方式使用outlook寄信時，加入附件，
    但對方收到後檔案開啟無法正常顯示圖片，出現：無法顯示連結的圖像。檔案可能已移動、重新命名或刪除。請驗證連結指向正確的檔案及位置。

    查詢好像是要用Shapes.AddPicture 的方式，
    請教要如何改為Shapes.AddPicture 呢？
    感謝~

ikboy

1. i = ThisWorkbook.Path & "\" & NewRef & ".jpg"
   
2.     X = Dir(ThisWorkbook.Path & "\" & NewRef & ".jpg")
   
3.     If X <> "" Then
   
4.         Set Rngs = Range(Cells(61, 2), Cells(61, 19))
   
5.         Set NewPicture = ActiveSheet.Pictures.Insert(i)
   
6.             xSize = .Height / .Width
   
7.             If .Height / .Width >= Rngs.Height / Rngs.Width Then
   
8.                 T = Rngs.Top
   
9.                 L = (Rngs.Width - .Width) / 2 + Rngs.Left
   
10.                 H = Rngs.Height
    
11.                 W = H / xSize
    
12.             Else
    
13.                 T = (Rngs.Height - .Height) / 2 + Rngs.Top
    
14.                 L = Rngs.Left
    
15.                 W = Rngs.Width
    
16.                 H = W * xSize
    
17.             End If
    
18.             .Delete
    
19.         End With
    
20.         Set NewPicture = ActiveSheet.Shapes.AddPicture(i, 1, 1, L, T, W, H)
    
21.     End If

複製代碼

takeshilin88

回復 12# ikboy


    ikboy大大您好：
    看明明設定都沒錯，但是出來圖片的位置卻偏右邊耶，不知道是哪裡有問題？

下載 (40.65 KB)

2020-10-8 14:51

ikboy

由於沒有圖片及附件做測試, 當中可能有Bug, 相信是第 9, 13 兩行的算法出問題。

ikboy

修改以下一段試試, 但還是那一句, 沒有測試。

1.     .ShapeRange.LockAspectRatio = msoTrue
   
2.     xp = Rngs.Height / .Height
   
3.     If .Height / .Width >= Rngs.Height / Rngs.Width Then
   
4.         .Height = Rngs.Height
   
5.         .Top = Rngs.Top
   
6.         .Left = (Rngs.Width - .Width * xp) / 2 + Rngs.Left
   
7.     Else
   
8.         .Width = Rngs.Width
   
9.         .Left = Rngs.Left
   
10.         .Top = (Rngs.Height - .Height * xp) / 2 + Rngs.Top
    
11.     End If

複製代碼

准提部林

Set rngs = Range(Cells(61, 2), Cells(61, 19))
With ActiveSheet.Shapes.AddPicture(i, False, True, rngs.Left, rngs.Top, True, True)
     .LockAspectRatio = msoFalse
     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

ikboy

喜歡准大這一句, 讚

1. With ActiveSheet.Shapes.AddPicture(i, False, True, rngs.Left, rngs.Top, True, True)

複製代碼

takeshilin88

回復 16# 准提部林


    感謝准大的回覆，圖片已經有置中了，但是圖片沒有等比例的在儲存格範圍內放大或縮小呢？
    可以再幫忙指導一下嗎？
    謝謝~~

下載 (30.98 KB)

2020-10-12 09:54

准提部林

回復 18# takeshilin88


.LockAspectRatio = True

takeshilin88

回復 19# 准提部林


    似乎沒什麼變化....

下載 (30.98 KB)

2020-10-12 10:43