Написание кода / макроса Excel VBA для заполнения текстовых полей Powerpoint с значениями ячейки Excel

Я пытаюсь использовать значение в ячейках Excel и заполнять текстовые поля PowerPoint. Я не хочу связывать таблицу PowerPoint с электронной таблицей Excel, потому что таблица постоянно меняется, а значения не всегда находятся в одних и тех же строках или в том же порядке.

Поэтому я пишу этот код VBA, чтобы попытаться заполнить текстовые поля. Я сделал много VBA, но никогда не пытался эту комбинацию. Ниже приведено то, что у меня есть до сих пор (больше кода будет добавлено для дополнительных текстовых полей, но нужно сначала получить одну работу). Я понимаю, что проблема связана с тем, что объект не обрабатывается должным образом, но не уверен, как его исправить.

Я использую Excel и PowerPoint 2007. Жирным выражением является то, где я получаю ошибку. Объект 438 не поддерживает это свойство или метод.

Благодаря!

Sub valppt() Dim PPT As PowerPoint.Application Dim newslide As PowerPoint.Slide Dim slideCtr As Integer Dim tb As PowerPoint.Shape Set PPT = CreateObject("PowerPoint.Application") PPT.Visible = True PPT.Presentations.Open "C:\Documents\createqchart.pptx" Range("F2").Activate slideCtr = 1 Set newslide = ActivePresentation.Slides(slideCtr).Duplicate Set tb = newslide.Shapes("TextBox1") slideCtr = slideCtr + 1 ' Do Until ActiveCell.Value = "" Do Until slideCtr > 2 If slideCtr = 2 Then tb.TextFrame2.TextRange.Characters.Text = ActiveCell.Value End If ActiveCell.Offset(0, 1).Activate slideCtr = slideCtr + 1 If slideCtr = 38 Then Set newslide = PPT.ActivePresentation.Slides(slideCtr).Duplicate ActiveCell.Offset(1, -25).Activate End If Loop End Sub 

ОБНОВЛЕНИЕ 5/17

Хотя репликация слайда работает, я все еще не могу оценить текстовое поле. Я не смог придумать правильное задание оператора перед заявлением, чтобы присвоить значение этому текстовому полю. Прямо сейчас у меня даже нет заданного утверждения прямо сейчас, потому что я не смог получить правильный. Любая помощь приветствуется. Ниже приведен последний код.

 Sub shptppt() ' ' shptppt Macro ' Dim PPT As PowerPoint.Application Dim pres As PowerPoint.Presentation Dim newslide As PowerPoint.Slide Dim slideCtr As Integer Dim tb As PowerPoint.Shape Set PPT = CreateObject("PowerPoint.Application") PPT.Visible = True Set pres = PPT.Presentations.Open("C:\Documents\createqchart.pptx") Range("F2").Activate slideCtr = 1 'Set newslide = ActivePresentation.Slides(slideCtr).Duplicate ' Set tb = newslide.Shapes("TextBox1") pres.Slides(slideCtr).Copy pres.Slides.Paste Set newslide = pres.Slides(pres.Slides.Count) newslide.MoveTo slideCtr + 1 slideCtr = slideCtr + 1 ' Do Until ActiveCell.Value = "" Do Until slideCtr > 2 If slideCtr = 2 Then tb.Slides.TextFrame2.TextRange.Characters.Text = ActiveCell.Value End If ActiveCell.Offset(0, 1).Activate slideCtr = slideCtr + 1 If slideCtr = 38 Then Set newslide = PPT.ActivePresentation.Slides(slideCtr).Duplicate ActiveCell.Offset(1, -25).Activate End If Loop End Sub 

txtReqBase недопустим. он не объявляется как переменная в вашем коде, и это, конечно, не поддерживается свойство / метод в Powerpoint, и именно поэтому вы получаете ошибку 438.

Чтобы вставить текст в фигуру, вам нужно определить форму, а затем обработать ее .Text . Мне легче всего это сделать с переменной формы.

 '## If you have enabled reference to Powerpoint, then:' Dim tb As Powerpoint.Shape '## If you do not enable Powerpoint reference, use this instead' 'Dim tb as Variant ' Set tb = newSlide.Shapes("TextBox1") '## Update this to use the correct name or index of the shapes collection ##' tb.TextFrame2.TextRange.Characters.Text = ActiveCell.Value 

ОБНОВЛЕНИЕ Для настройки ошибки несоответствия tb .

Я думаю, что вы получаете ошибку несоответствия, потому что у вас есть PPT As Object а не включение ссылки на библиотеку объектов Powerpoint, которая позволит вам полностью измерить ее как PowerPoint.Application .

Ваш текущий код интерпретирует Dim tb as Shape относится к Excel.Shape, а не Powerpoint.Shape.

Если вы включите ссылку на библиотеку объектов Powerpoint, вы можете сделать

 Dim PPT as Powerpoint.Application Dim newSlide as Powerpoint.Slide Dim tb as Powerpoint.Shape 

Если вы не хотите или не можете ссылаться на библиотеку объектов PPT, попробуйте Dim tb as Variant или Dim tb as Object и это может сработать.

ОБНОВЛЕНИЕ 2 Как включить ссылку на Powerpoint:

В VBE из Tools | Ссылки, установите флажок, соответствующий версии PPT, поддерживаемой на вашем компьютере. В Excel 2010 это 14.0. В 2007 году я думаю, что это 12,0.

Включить ссылку на библиотеку объектов PPT

Обновление 3

Duplicate Method, похоже, не доступен в 2007 году. В любом случае это также вызывает странную ошибку в 2010 году, хотя слайд скопирован правильно, переменная не установлена.

Попробуйте это вместо этого:

 Sub PPTTest() Dim PPT As PowerPoint.Application Dim pres As PowerPoint.Presentation Dim newslide As PowerPoint.Slide Dim slideCtr As Integer Dim tb As PowerPoint.Shape Set PPT = CreateObject("PowerPoint.Application") PPT.Visible = True 'Control the presentation with a variable Set pres = PPT.Presentations.Open("C:\users\david_zemens\desktop\Presentation1.pptx") Range("F2").Activate slideCtr = 1 '## This only works in 2010/2013 ## 'pres.Slides(slideCtr).Duplicate '## Use this method in Powerpoint 2007 (hopefully it works) pres.Slides(slideCtr).Copy pres.Slides.Paste Set newslide = pres.Slides(pres.Slides.Count) newslide.MoveTo slideCtr + 1 ... 

Я забыл, что я переключился с текстового поля на текстовое поле управления activex. вот правильный код.

 valppt() Dim PPT As PowerPoint.Application Dim newslide As PowerPoint.SlideRange Dim slideCtr As Integer Dim tb As PowerPoint.Shape Set PPT = CreateObject("PowerPoint.Application") PPT.Visible = True PPT.Presentations.Open ("C:\Documents\createqchart.pptx") Range("F2").Activate slideCtr = 1 Set newslide = PPT.ActivePresentation.Slides(slideCtr).Duplicate Set tb = newslide.Shapes("TextBox" & slideCtr) slideCtr = slideCtr + 1 Do Until ActiveCell.Value = "" 'Do Until slideCtr > 2 If slideCtr = 2 Then tb.OLEFormat.Object.Value = Format(ActiveCell.Value, "m/d/yyyy") End If ActiveCell.Offset(0, 1).Activate slideCtr = slideCtr + 1 If slideCtr = 38 Then Set newslide = PPT.ActivePresentation.Slides(slideCtr).Duplicate ActiveCell.Offset(1, -25).Activate End If Loop End Sub 
  • Скопировать и вставить содержимое из текстового поля в диапазон ячеек рабочего листа?
  • Как активировать входной режим с VBA на текстовом поле неактивного x, вставленного в рабочий лист?
  • Удалить строку из текстового поля, форм и т. Д., Которые могут быть сгруппированы
  • Выделить текст в Userform TextBox
  • Форматирование текстовых полей в форме пользователя
  • Текстовое поле ActiveX на листе листа Excel заменяет границу и шрифт при утрате фокуса
  • Добавление текстовых и текстовых значений в ячейку
  • Как получить доступ к текстовому блоку, размещенному на листе в модуле VBA?
  • Создание текстового поля для запуска формулы VBA
  • Как установить имя текстового поля как переменную и разрешить изменять имя в цикле?
  • Ярлык, связанный с значением текстового поля
  • Interesting Posts

    ActiveCell.Offset Confusion

    Excel – лучший способ отобразить изменение ячейки в зависимости от изменения другой ячейки

    Возврат значения из Excel

    Импорт нескольких текстовых файлов для разделения рабочих листов в существующей книге

    Чтение файлов Excel в R с помощью XLConnect: завершение работы с памятью Java

    Массивы VBA с бок о бок

    Adapt VBA Module, чтобы найти частичное совпадение вместо точного соответствия

    Заполните таблицу xlsx с помощью xlsx4j в Java

    ASP.NET MVC – загрузка файла Excel из MemoryStream (поврежденный файл)

    ЕСЛИ ВЫПОЛНЯЕТСЯ В EXCEL

    averageifs, если дата в ячейке меньше даты в следующей ячейке

    автоматически создайте лист со значением ячейки и гиперссылки на значение ячейки для него

    Ошибка Excel Vba: определения процедур свойств для одного и того же свойства несовместимы

    Как получить числа в Lakhs с 4-значной десятичной округлой фракцией в excel?

    excel 2003 vba: написать формулу в ячейку

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