[發問] EXCEL 刪除所有圖片

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

8^#

發表於 2012-9-27 15:38 | 只看該作者

回復 7# whirlwind963
可參考這裡 http://forum.twbts.com/viewthread.php?tid=687

Sub Macro1()
Dim E As Shape, j, NN
Sheets("Sheet1").Select
For Each E In ActiveSheet.Shapes
If E.Type = 13 Then E.Delete
'If InStr(E.Name, "Picture") Then E.Delete '這也可以
Next
j = 2
While Cells(j, "C") <> ""
NN = Cells(j, "C")
Cells(j, "D").Select
ActiveSheet.Pictures.Insert( _
NN). _
Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 100#
Selection.ShapeRange.Width = 100#
Selection.ShapeRange.Rotation = 0#
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
j = j + 1
Wend
Range("C2").Select
End Sub

複製代碼

whirlwind963

小學生 Rank: 1

帖子: 29
主題: 7
精華: 0
積分: 42
點名: 0
作業系統: XP
軟體版本: OFFICE 2003
閱讀權限: 10
註冊時間: 2012-9-22
最後登錄: 2013-1-9

7^#

發表於 2012-9-27 13:25 | 只看該作者

回復 6# GBKEE
麻煩幫我看一下
當我按下BUTTOM後
圖片可以刪除
但是BUTTOM也會跟著刪除

Book1.rar (8.83 KB)

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

6^#

發表於 2012-9-27 13:05 | 只看該作者

回復 5# whirlwind963
你程式中沒看到刪掉bottom (Shape物件)的程式碼
附上檔案看看

whirlwind963

小學生 Rank: 1

帖子: 29
主題: 7
精華: 0
積分: 42
點名: 0
作業系統: XP
軟體版本: OFFICE 2003
閱讀權限: 10
註冊時間: 2012-9-22
最後登錄: 2013-1-9

5^#

發表於 2012-9-26 16:58 | 只看該作者

回復 4# GBKEE

Private Sub CommandButton1_Click()
Macro1
End Sub
我是用buttom執行macro1的

帖子: 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-26 16:37 | 只看該作者

回復 3# whirlwind963
程式中沒看到刪掉bottom (Shape物件)的程式碼

Sub Macro1()
Sheets("Sheet1").Select
ActiveSheet.Pictures.Delete '在此程式只刪一次照片
j = 2
While Cells(j, "C") <> ""
' ActiveSheet.Pictures.Delete
'在迴圈中一直刪照片對於後面的Pictures.Insert 有何意義
NN = Cells(j, "C")
Cells(j, "D").Select
ActiveSheet.Pictures.Insert( _
NN). _
Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 100#
Selection.ShapeRange.Width = 100#
Selection.ShapeRange.Rotation = 0#
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
j = j + 1
Wend
Range("C2").Select
End Sub

複製代碼

whirlwind963

小學生 Rank: 1

帖子: 29
主題: 7
精華: 0
積分: 42
點名: 0
作業系統: XP
軟體版本: OFFICE 2003
閱讀權限: 10
註冊時間: 2012-9-22
最後登錄: 2013-1-9

3^#

發表於 2012-9-26 16:13 | 只看該作者

回復 2# GBKEE

Private Sub CommandButton1_Click()
Macro1
End Sub

Sub Macro1()
Sheets("Sheet1").Select
j = 2
While Cells(j, "C") <> ""
      ActiveSheet.Pictures.Delete
      NN = Cells(j, "C")
      Cells(j, "D").Select
      ActiveSheet.Pictures.Insert( _
      NN). _
      Select
      Selection.ShapeRange.LockAspectRatio = msoTrue
      Selection.ShapeRange.Height = 100#
      Selection.ShapeRange.Width = 100#
      Selection.ShapeRange.Rotation = 0#
      With Selection
      .Placement = xlMoveAndSize
      .PrintObject = True
      End With
j = j + 1
Wend
Range("C2").Select
End Sub
請問我的原始碼是上面的
要怎麼辦才能不刪掉bottom呢

帖子: 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 15:54 | 只看該作者

回復 1# whirlwind963
工作表的bottom 執行 ActiveSheet.Pictures.Delete 這程式碼
參考這裡 Application.Caller