[發問] EXCEL 刪除所有圖片

whirlwind963

ActiveSheet.Pictures.Delete
這個指令能刪除工作表裡的所有圖片
但是如何做才能不刪掉工作表的bottom呢

GBKEE

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

whirlwind963

回復 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呢

GBKEE

回復 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

複製代碼

whirlwind963

回復 4# GBKEE


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

GBKEE

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

whirlwind963

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

GBKEE

回復 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

複製代碼