返回列表 上一主題 發帖

[發問] EXCEL 刪除所有圖片

whirlwind963

帖子
29 
主題
7 
精華
0 
積分
42 
點名
0  
作業系統
XP 
軟體版本
OFFICE 2003 
閱讀權限
10 
註冊時間
2012-9-22 
最後登錄
2013-1-9 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-9-26 15:39 | 只看該作者

[發問] EXCEL 刪除所有圖片

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

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 15:54 | 只看該作者
回復 1# whirlwind963
工作表的bottom   執行 ActiveSheet.Pictures.Delete 這程式碼
參考這裡   Application.Caller

TOP

whirlwind963

帖子
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呢

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

whirlwind963

帖子
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的

TOP

GBKEE

帖子
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物件)的程式碼
附上檔案看看

TOP

whirlwind963

帖子
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)

TOP

GBKEE

帖子
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
   
  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

        靜思自在 : 一句溫暖的話，就像往別人身上灑香水，自己會沾到兩三滴。
返回列表 上一主題