返回列表 上一主題 發帖

[發問] EXCEL 刪除所有圖片

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2012-9-26 15:54 | 顯示全部帖子
回復 1# whirlwind963
工作表的bottom   執行 ActiveSheet.Pictures.Delete 這程式碼
參考這裡   Application.Caller

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2012-9-26 16:37 | 顯示全部帖子
回復 3# whirlwind963
程式中沒看到刪掉bottom (Shape物件)的程式碼
  1. Sub Macro1()
  2.     Sheets("Sheet1").Select
  3.     ActiveSheet.Pictures.Delete      '在此程式只刪一次照片
  4.     j = 2
  5.     While Cells(j, "C") <> ""
  6.        ' ActiveSheet.Pictures.Delete  
  7.      '在迴圈中一直刪照片 對於後面的Pictures.Insert 有何意義
  8.         NN = Cells(j, "C")
  9.         Cells(j, "D").Select
  10.         ActiveSheet.Pictures.Insert( _
  11.          NN). _
  12.         Select
  13.         Selection.ShapeRange.LockAspectRatio = msoTrue
  14.         Selection.ShapeRange.Height = 100#
  15.         Selection.ShapeRange.Width = 100#
  16.         Selection.ShapeRange.Rotation = 0#
  17.         With Selection
  18.         .Placement = xlMoveAndSize
  19.         .PrintObject = True
  20.         End With
  21.     j = j + 1
  22.     Wend
  23.     Range("C2").Select
  24. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2012-9-27 13:05 | 顯示全部帖子
回復 5# whirlwind963
你程式中沒看到刪掉bottom (Shape物件)的程式碼
附上檔案看看

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2012-9-27 15:38 | 顯示全部帖子
回復 7# whirlwind963
可參考 這裡  http://forum.twbts.com/viewthread.php?tid=687
   
  1. Sub Macro1()
  2.      Dim E As Shape, j, NN
  3.     Sheets("Sheet1").Select
  4.     For Each E In ActiveSheet.Shapes
  5.         If E.Type = 13 Then E.Delete
  6.         'If InStr(E.Name, "Picture") Then E.Delete '這也可以
  7.     Next
  8.     j = 2
  9.     While Cells(j, "C") <> ""
  10.         NN = Cells(j, "C")
  11.         Cells(j, "D").Select
  12.         ActiveSheet.Pictures.Insert( _
  13.          NN). _
  14.         Select
  15.         Selection.ShapeRange.LockAspectRatio = msoTrue
  16.         Selection.ShapeRange.Height = 100#
  17.         Selection.ShapeRange.Width = 100#
  18.         Selection.ShapeRange.Rotation = 0#
  19.         With Selection
  20.         .Placement = xlMoveAndSize
  21.         .PrintObject = True
  22.         End With
  23.     j = j + 1
  24.     Wend
  25.     Range("C2").Select
  26. End Sub
複製代碼

TOP

        靜思自在 : 【做人的開始】每一天都是故人的開始，每一個時刻都是自己的警惕。
返回列表 上一主題