0

现在一切都修复了..我忘记了我使用的是 activex 控件文本框，而不是“正常”的 PPT 文本框。这是填充单个文本框的正确基本代码。

感谢 David Zemens，我解决了我遇到的一些早期问题，但我仍然无法实现我的最终目标。他觉得最好开始一个新线程，所以就在这里。

我做的第一件事是打开 PPT 文件并复制第一张幻灯片。复制方法是复制幻灯片，但会导致其他问题，所以戴夫给我一个解决方法，改变他们复制主幻灯片的方式。下面是我写的代码，暂时不会编译。（此外，我已修改为只写入一个文本框，而不是使用循环，一旦我开始工作，最终将完成）

任何意见将是有益的。如果您需要更多信息，请告诉我，谢谢！

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 slideCtr > 2
    If slideCtr = 2 Then
       'tb.TextFrame.TextRange.Characters.Text = Format(ActiveCell.Value, "m/d/yyyy")
       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

结束子

4

1 回答 1

1

这是正确的代码。

Sub 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 slideCtr > 2
    If slideCtr = 2 Then
       'tb.TextFrame.TextRange.Characters.Text = Format(ActiveCell.Value, "m/d/yyyy")
       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
于 2013-05-20T13:19:38.217 回答