返回列表 上一主題 發帖

一個圖片問題

周大偉

帖子
250 
主題
59 
精華
0 
積分
313 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
澳門 
註冊時間
2010-9-11 
最後登錄
2020-1-6 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-6-23 21:50 | 只看該作者

一個圖片問題

請教大大前輩們,
小弟有一插入圖片問題, 懇請大大們協助, 小弟把問題寫於付件內, 希望能有回應, 謝謝!!
dd.rar (142.67 KB)
收藏 分享

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 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
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

周大偉

帖子
250 
主題
59 
精華
0 
積分
313 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
澳門 
註冊時間
2010-9-11 
最後登錄
2020-1-6 
3#
發表於 2016-6-24 13:57 | 只看該作者
回復 2# stillfish00

謝謝前輩，

TOP

        靜思自在 : 人生不一定球球是好球，但是有歷練的強打者，隨時都可以揮棒。
返回列表 上一主題