求代码：批量删除当前目录的所有工作簿中的对象。

星语心愿

导出的课程表中第二列有文本框。求一个代码，保存在当前文件夹中，会删除当前文件夹中的其他所有工作簿中的所有工作表的对象上，包括文本框和对象。 删除第二行的文本框.rar (27.47 KB, 下载次数: 6)

2024-9-9 13:43 上传

点击文件名下载附件

希望得到朋友们的帮助，不胜感激。

小凡、、、

参与一下，删除文件夹内所有工作簿的对象

星语心愿

小凡、、、 发表于 2024-9-9 14:16
参与一下，删除文件夹内所有工作簿的对象

斜线表头都被删除了吗？意思是这个代码可不可以做成一个单独的工作簿。

小凡、、、

星语心愿 发表于 2024-9-9 15:04
斜线表头都被删除了吗？意思是这个代码可不可以做成一个单独的工作簿。

可以呀，你把代码保存一个文件，放到那个文件夹下运行都行，要不删除斜线的话，shp循环里加个判断，只删除哪些类型或不删除哪些类型的shp对象

星语心愿

小凡、、、 发表于 2024-9-9 15:33
可以呀，你把代码保存一个文件，放到那个文件夹下运行都行，要不删除斜线的话，shp循环里加个判断，只删 ...

您方便帮个忙吗？修改代码我是真的一点都不会。真的感谢了。

taller

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()    '//2024.9.10
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     p = ThisWorkbook.Path & ""
   
6.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
7.     For Each f In fso.GetFolder(p).Files
   
8.         If LCase(f.Name) Like "*.xls*" Then
   
9.             If InStr(f, "~$") = 0 Then
   
10.                 If InStr(f, ThisWorkbook.Name) = 0 Then
    
11.                     Set wb = Workbooks.Open(f, 0)
    
12.                     For Each sht In wb.Sheets
    
13.                         For Each shp In sht.DrawingObjects
    
14.                             If TypeName(shp) = "Picture" Then shp.Delete
    
15.                         Next
    
16.                     Next
    
17.                     wb.Close 1
    
18.                 End If
    
19.             End If
    
20.         End If
    
21.     Next
    
22.     Application.ScreenUpdating = True
    
23.     MsgBox "OK！"
    
24. End Sub
    

复制代码