標題: 一個圖片問題 [打印本頁]

---

作者: 周大偉    時間: 2016-6-23 21:50     標題: 一個圖片問題

請教大大前輩們,
小弟有一插入圖片問題, 懇請大大們協助, 小弟把問題寫於付件內, 希望能有回應, 謝謝!!
[attach]24548[/attach]

---

作者: stillfish00    時間: 2016-6-24 10:28

回復 1# 周大偉

1. Sub Test()
   
2.     Dim v, pic As Object, currentCell As Range
   
3.     If StrComp(TypeName(Selection), "Range", vbTextCompare) <> 0 Then MsgBox "Please select a cell to insert picture": Exit Sub
   
4.     Set currentCell = Selection
   
5.    
   
6.     v = Application.GetOpenFilename("All Files (*.*), *.*,Pictures (*.jpg;*.bmp;*.png;*.gif),*.jpg;*.bmp;*.png;*.gif", 2, "Select Insert Pictures")
   
7.     If StrComp(TypeName(v), "Boolean", vbTextCompare) = 0 Then Exit Sub
   
8.    
   
9.     Set pic = ActiveSheet.Pictures.Insert(v)
   
10.     If pic Is Nothing Then Exit Sub
    
11.     With pic
    
12.         .Left = currentCell.Left
    
13.         .Top = currentCell.Top
    
14.         .ShapeRange.LockAspectRatio = msoFalse
    
15.         .ShapeRange.ScaleWidth currentCell.Width / .Width, msoFalse, msoScaleFromTopLeft
    
16.         .ShapeRange.ScaleHeight currentCell.Height / .Height, msoFalse, msoScaleFromTopLeft
    
17.     End With
    
18. End Sub

複製代碼

---

作者: 周大偉    時間: 2016-6-24 13:57

回復 2# stillfish00

謝謝前輩，

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)