Удалить строку из текстового поля в слайде PowerPoint из папки – Компонент Error ActiveX не может создать объект

Я хотел бы перебрать все ppt из папки и удалить строку, если она найдена в любом текстовом поле в любом слайде.

Я новичок в работе с слайдами Powerpoint, поэтому вам нужно несколько советов и советов, как работать с ним.

Option Compare Text Option Explicit Sub Test() Dim Sld As Slide, Shp As Shape Dim strFileName As String Dim strFolderName As String Dim PP As Presentation Dim strf As String 'String to be deleted. strf = InputBox("Enter the string.", "Delete String from PPT.", "AAAAA") 'Opens a PowerPoint Document from Excel Dim objPPT As Object Set objPPT = CreateObject("PowerPoint.Application") objPPT.Visible = True 'set default directory here if needed strFolderName = "C:\Users\Desktop\Files" strFileName = Dir(strFolderName & "\*.ppt*") Do While Len(strFileName) > 0 objPPT.Presentations.Open strFolderName & "\" & strFileName objPPT.Presentations.Activate For Each Sld In ActivePresentation.Slides 'Error - ActiveX Component can't create object. For Each Shp In Sld.Shapes Select Case Shp.Type Case MsoShapeType.msoTextBox Debug.Print Sld.Name, Shp.Name, Shp.TextFrame.TextRange.Text Case Else Debug.Print Sld.Name, Shp.Name, "This is not a text box" End Select Next Shp Next Sld objPPT.Presentations.Close strFileName = Dir Loop End Sub 

Когда вы запускаете макрос в Excel, вы забыли указать, откуда находится ActivePresentation . Он должен работать, если у вас есть objPPT.ActivePresentation.Slides . В любом случае, вы можете попробовать ниже пересмотренный код:

 'Option Compare Text Option Explicit Sub Test() 'Dim Sld As Slide, Shp As Shape ' <-- Excel doesn't know Slide if Reference not added Dim Sld As Object, Shp As Object Dim strFileName As String Dim strFolderName As String 'Dim PP As Presentation Dim PP As Object ' Use this Presentation Object! Dim strf As String 'String to be deleted. strf = InputBox("Enter the string.", "Delete String from PPT.", "AAAAA") 'Opens a PowerPoint Document from Excel Dim objPPT As Object Set objPPT = CreateObject("PowerPoint.Application") objPPT.Visible = True ' <-- don't need this, for debug only 'set default directory here if needed strFolderName = "C:\Users\Desktop\Files" strFileName = Dir(strFolderName & "\*.ppt*") Do While Len(strFileName) > 0 'objPPT.Presentations.Open strFolderName & "\" & strFileName Set PP = objPPT.Presentations.Open(strFolderName & "\" & strFileName) 'objPPT.Presentations.Activate PP.Activate ' <-- don't need this, for debug only 'For Each Sld In ActivePresentation.Slides 'Error - ActiveX Component can't create object. ' Should work if it's "objPPT.ActivePresentation.Slides" For Each Sld In PP.Slides For Each Shp In Sld.Shapes With Shp Select Case .Type Case MsoShapeType.msoTextBox If InStr(1, .TextFrame.TextRange.Text, strf, vbTextCompare) > 0 Then Debug.Print Sld.Name, .Name, .TextFrame.TextRange.Text Else Debug.Print Sld.Name, .Name, """" & strf & """ not found in text body" End If Case Else Debug.Print Sld.Name, .Name, "This is not a text box" End Select End With Next Shp Next Sld 'objPPT.Presentations.Close PP.Close Set PP = Nothing strFileName = Dir Loop End Sub 

UPDATE – разрешить обработку уже открытых файлов и некоторые настройки:

 Option Explicit Sub Test() Const strFolderName = "C:\Users\Desktop\Files\" Dim objPPT As Object, PP As Object, Sld As Object, Shp As Object Dim strFileName As String Dim strf As String 'String to be deleted. strf = InputBox("Enter the string.", "Delete String from PPT.", "AAAAA") If Len(Trim(strf)) = 0 Then Exit Sub ' Exit if blank text returned 'Opens a PowerPoint Document from Excel Set objPPT = CreateObject("PowerPoint.Application") 'set default directory here if needed strFileName = Dir(strFolderName & "*.ppt*") Do While Len(strFileName) > 0 On Error Resume Next ' Try to get existing one with same name Set PP = objPPT.Presentations(strFileName) ' If not opened, try open it If PP Is Nothing Then Set PP = objPPT.Presentations.Open(strFolderName & strFileName) On Error GoTo 0 ' Process the Presentation Slides if it's opened If PP Is Nothing Then Debug.Print "Cannot open file! """ & strFolderName & strFileName & """" Else Application.StatusBar = "Processing PPT file: " & PP.FullName Debug.Print String(50, "=") Debug.Print "PPT File: " & PP.FullName For Each Sld In PP.Slides For Each Shp In Sld.Shapes With Shp If .Type = MsoShapeType.msoTextBox Then If InStr(1, .TextFrame.TextRange.Text, strf, vbTextCompare) > 0 Then Debug.Print Sld.Name, .Name, .TextFrame.TextRange.Text Else Debug.Print Sld.Name, .Name, """" & strf & """ not found in text body" End If End If End With Next Shp Next Sld PP.Close ' Close the Presentation Set PP = Nothing End If strFileName = Dir Loop Application.StatusBar = False ' Quit PowerPoint app objPPT.Quit Set objPPT = Nothing End Sub 

Я не могу объяснить ошибку, которую вы получаете. Я также ожидал, что код будет работать. Тем не менее, я наткнулся на эту проблему раньше и нашел следующее решение, которое (как ни странно) работает:

 Option Compare Text Option Explicit Sub Test() Dim Sld As Long, Shp As Long Dim strFileName As String Dim strFolderName As String Dim PP As PowerPoint.Presentation Dim strf As String 'String to be deleted. strf = InputBox("Enter the string.", "Delete String from PPT.", "AAAAA") 'Opens a PowerPoint Document from Excel Dim objPPT As PowerPoint.Application Set objPPT = New PowerPoint.Application objPPT.Visible = True 'set default directory here if needed strFolderName = "C:\Users\Desktop\Files" strFileName = Dir(strFolderName & "\*.ppt*") Do While Len(strFileName) > 0 Set PP = objPPT.Presentations.Open(strFolderName & "\" & strFileName) 'objPPT.Presentations.Activate For Sld = 1 To PP.Slides.Count For Shp = 1 To PP.Slides.Item(Sld).Shapes.Count With PP.Slides.Item(Sld).Shapes.Item(Shp) Select Case .Type Case MsoShapeType.msoTextBox Debug.Print .Name, .Name, .TextFrame.TextRange.Text Case Else Debug.Print .Name, .Name, "This is not a text box" End Select End With Next Shp Next Sld PP.Close Set PP = Nothing strFileName = Dir Loop objPPT.Quit Set objPPT = Nothing End Sub 

Примечание. Это решение использует раннее связывание вместо позднего связывания. Таким образом, вам нужно будет добавить ссылку на Microsoft PowerPoint xx.x Object Library

  • Автоматическое заполнение текстового поля в Excel VBA
  • Добавление текста в текстовое поле
  • Как установить текстовое поле в пользовательской форме для дробного значения?
  • VBA выводит значение ComboBox в следующую свободную ячейку в столбце
  • Размер текста Excel / PowerPoint после сжатия
  • Excel: текстовое поле объекта не может выполнять возврат каретки в защищенных или незащищенных состояниях листа (w / Text Unlocked) ... почему?
  • Написание кода / макроса Excel VBA для заполнения текстовых полей Powerpoint с значениями ячейки Excel
  • Как установить имя текстового поля как переменную и разрешить изменять имя в цикле?
  • Определите номер недели, номер месяца, год с момента управления DatePicker в пользовательской форме VBA
  • Копирование / управление форматированным текстом в текстовых блоках в Excel 2013 с использованием VBA
  • Добавление чисел с использованием форм Excel
  • Interesting Posts

    CSV не экспортируется после слияния

    Excel / VBA – как хранить информацию в классе так же

    Зацикливание на разных диапазонах ячеек для записи формул в каждом из них с использованием VBA

    Вложенные, если не работает в Google Таблицах

    Сортировка мертвых гиперссылок в Excel с помощью VBA?

    Подсчитывайте, если один столбец содержит и уникален в другом

    Недопустимая погрешность подстроки – объединение таблиц

    Код VBA не выполняется должным образом при вызове

    Использование Excel для подсчета голосов в столбцах

    Как обрезать ведущие пространства при импорте Excel в mysql

    Excel назвал диапазоны для создания добавочных заголовков и подзаголовков

    Запуск макросов и завершение, если условия выполнения выполнены

    Ошибка компиляции, затем без

    Как экспортировать файл excel с помощью PHP в базу данных Mysql

    Формула Excel для получения изменчивого значения приращения

    Давайте будем гением компьютера.