Страницы: 1
RSS
Удаление объектов из всех файлов в определенной папке
 
Добрый день, планетяне!

Есть папка, в которой находится около 500 файлов. В каждом файле на первом (и единственном листе) расположены таблица и графические объекты. Необходимо открыть каждый файл, удалить все графические объекты, сохранить и закрыть.
Очень поджимает фактор времени. Прошу помочь.
Заранее благодарю.

P.S. Понимаю, что просьба не очень корректная. Сам пытался через макрорекордер, но он выдает три строки, не очень мне понятные, а разбираться сейчас времени нет.
 
Пишите в личку раз времени нет. Не обязательно мне - здесь много достойных людей.

Но могу подкинуть свою статью: Просмотреть все файлы в папке
Применив её можно сделать большую часть работы - т.е. открыть поочередно файлы. А уж удалить объекты - дело малое.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Спасибо.
 
Код
Sub DeleteShapesFromAllFiles()

    Dim sh As Shape
    Dim wkb As Workbook, wks As Worksheet
    Dim f As Object, fso As Object
    Dim sFolderPath As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path & "\"
        If .Show Then
            sFolderPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    Application.ScreenUpdating = False
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each f In fso.GetFolder(sFolderPath).Files
        Set wkb = Workbooks.Open(f.Path)
        Set wks = wkb.Sheets(1)
        For Each sh In wks.Shapes
            sh.Delete
        Next
        wkb.Close SaveChanges:=True
    Next

    MsgBox "Обработка закончена!", vbInformation

End Sub
There is no knowledge that is not power
 
если объектов достаточно много, то быстрее, наверное, так:
Код
  Dim s As Shapes
  Set s = wkb.Sheets(1).Shapes
  If s.Count Then s.SelectAll: Selection.Delete
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Johny, огромное Вам спасибо. Очень выручили.
 
ikki, ответы идут с разницей в секунду, не успеваю правильно реагировать ))
В принципе, я уже все сделал с помощью макроса Johny. В сравнении  с предполагаемым ручным трудом, скорость макроса мгновенна )).
Спасибо за отклик.
 
Цитата
Johny пишет:
For Each sh In wks.Shapes
           sh.Delete
       Next
Цитата
ikki пишет:
Set s = wkb.Sheets(1).Shapes
 If s.Count Then s.SelectAll: Selection.Delete

вспоминаем, чему учил Сергей (KukLP)
Код
Sheet.DrawingObjects.Delete
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук


https://github.com/nervgh
 
Цитата
nerv пишет:

Код
 Sheet.DrawingObjects.Delete 

DrawingObjects - скрытый объект, в IntelliSense не появляется.  :)
А вот если нажать F2, потом ПКМ, а потом "Show Hidden Members", тогда появится. :)
Изменено: Johny - 17.01.2013 14:16:18
There is no knowledge that is not power
 
Цитата
Johny пишет:
А вот если нажать F2, потом ПКМ, а потом "Show Hidden Members", тогда появится.  :)
будем знать  А можно сделать их отображаемыми по умолчанию?
Изменено: nerv - 17.01.2013 17:00:37
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук


https://github.com/nervgh
 
Цитата
nerv пишет:
А можно сделать их отображаемыми по умолчанию?

К сожалению, нет. :(
There is no knowledge that is not power
Страницы: 1
Наверх