一個圖片問題

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2016-6-23 21:50 | 只看該作者

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

dd.rar (142.67 KB)

2^#

發表於 2016-6-24 10:28 | 只看該作者

回復 1# 周大偉

Sub Test()
Dim v, pic As Object, currentCell As Range
If StrComp(TypeName(Selection), "Range", vbTextCompare) <> 0 Then MsgBox "Please select a cell to insert picture": Exit Sub
Set currentCell = Selection
v = Application.GetOpenFilename("All Files (*.*), *.*,Pictures (*.jpg;*.bmp;*.png;*.gif),*.jpg;*.bmp;*.png;*.gif", 2, "Select Insert Pictures")
If StrComp(TypeName(v), "Boolean", vbTextCompare) = 0 Then Exit Sub
Set pic = ActiveSheet.Pictures.Insert(v)
If pic Is Nothing Then Exit Sub
With pic
.Left = currentCell.Left
.Top = currentCell.Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.ScaleWidth currentCell.Width / .Width, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight currentCell.Height / .Height, msoFalse, msoScaleFromTopLeft
End With
End Sub

複製代碼

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

3^#

發表於 2016-6-24 13:57 | 只看該作者

回復 2# stillfish00

謝謝前輩，

靜思自在 : 能付出愛心就是福，能消除煩惱就是慧。