将文本从Excel中的列导入PowerPoint中的特定/指定文本框?

我有大约400行数据的Excel文档。 他们按列sorting。 例如,列A是名称,B是组,C是位置,D是部门,E是注释,F是提交者。

我需要这些数据进入PowerPoint文件中的特定文本框。 我发现了下面的代码:

Sub CreateSlides() 'Open the Excel workbook. Change the filename here. Dim OWB As New Excel.Workbook Set OWB = Excel.Application.Workbooks.Open("C:\list.xlsx") 'Grab the first Worksheet in the Workbook Dim WS As Excel.Worksheet Set WS = OWB.Worksheets(1) 'Loop through each used row in Column A For i = 1 To WS.Range("A65536").End(xlUp).Row 'Copy the first slide and paste at the end of the presentation ActivePresentation.Slides(1).Copy ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1) 'Change the text of the first text box on the slide. ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = WS.Cells(i, 1).Value Next End Sub 

它创build了几个幻灯片(应该有),并将列A中的信息导入本应放置的位置。

我的问题是我不知道如何让文本的其余部分填充它应该在哪里。

假设您想要将每个Excel行以相同的格式传递给单独的PPT幻灯片,则可以创build一个包含可通过Excel VBA填充的文本框或表的PPT幻灯片。 创buildPPT幻灯片后,可以通过使用“立即”窗口获取对象名称,通过PPT中的VBA编辑器获取名称或单元格地址(分别用于文本框或表格)。 select您的幻灯片中的第一个对象,然后在PPT立即窗口中键入以下内容,然后按回车键。

 ?activewindow.Selection.shaperange.Name 

我经常做的是通过select形状并input我想要调用的名称来为名称分配形状。 然后,我切换到即时窗口,其形状仍然处于选中状态,然后键入:

 activewindow.Selection.shaperange.Name=activewindow.Selection.shaperange.TextFrame.TextRange.Text 

请注意没有问号在此之前,因为您正在分配一个形状的名称不问问它的名字是什么。

最后,在Excel程序代码中,我使用如下所示的语句分配实际值:

 aSlide.Shapes("MyShapeName").TextFrame.TextRange.Text = _ aCell.Offset(0, iCol).Value 

以下是从Excel VBA加载100张幻灯片的最新示例

 Private Sub PPTLoad() Dim PPT As PowerPoint.Application Dim PPTPres As Presentation Dim PPTFIleName As Variant Dim iCnt As Integer Dim aSlide As PowerPoint.SlideRange Dim sWS As Worksheet Dim aCell As Range Dim lRow As Long Dim sld As Slide Dim iCol As Integer Set sWS = ThisWorkbook.Sheets("vwRawData") lRow = sWS.UsedRange.Rows.Count Set PPT = New PowerPoint.Application PPT.Visible = True PPTFIleName = FileBrowse("*.ppt", "Open PowerPoint Template") If PPTFIleName = "" Then Exit Sub End If Set PPTPres = PPT.Presentations.Open(Filename:=PPTFIleName) With PPTPres For Each aCell In sWS.Range("A3:A" & lRow) For iCnt = 1 To aSlide.Shapes.Count iCol = 2 Select Case aSlide.Shapes(iCnt).Name Case "BizGroup" 'A iCol = 0 aSlide.Shapes(iCnt).TextFrame.TextRange.Text = _ aCell.Offset(0, iCol).Value Case "Division" 'B iCol = 1 aSlide.Shapes(iCnt).TextFrame.TextRange.Text = _ aCell.Offset(0, iCol).Value Case "NPPPjtNbr" 'D iCol = 3 aSlide.Shapes(iCnt).TextFrame.TextRange.Text = _ aCell.Offset(0, iCol).Value Case "PgmName" 'E iCol = 4 aSlide.Shapes(iCnt).TextFrame.TextRange.Text = _ aCell.Offset(0, iCol).Value Case "Description" 'F iCol = 5 aSlide.Shapes(iCnt).TextFrame.TextRange.Text = _ aCell.Offset(0, iCol).Value Case "ValueProposition" 'G iCol = 6 aSlide.Shapes(iCnt).TextFrame.TextRange.Text = _ aCell.Offset(0, iCol).Value Case "NPICurrentPhase" 'H iCol = 7 aSlide.Shapes(iCnt).TextFrame.TextRange.Text = _ aCell.Offset(0, iCol).Value Case "LaunchDate" 'I iCol = 8 aSlide.Shapes(iCnt).TextFrame.TextRange.Text = _ Format(aCell.Offset(0, iCol).Value, "mmm-yy") Case "Class" 'J iCol = 9 aSlide.Shapes(iCnt).TextFrame.TextRange.Text = _ aCell.Offset(0, iCol).Value Case "SalesYTDCY" 'K iCol = 10 aSlide.Shapes(iCnt).TextFrame.TextRange.Text = _ Format(aCell.Offset(0, iCol).Value / 1000000, "$#.0M") Case "OPPlanCY" 'L iCol = 11 aSlide.Shapes(iCnt).TextFrame.TextRange.Text = _ Format(aCell.Offset(0, iCol).Value / 1000000, "$#.0M") Case "CYPlus1Forecast" 'M iCol = 12 aSlide.Shapes(iCnt).TextFrame.TextRange.Text = _ Format(aCell.Offset(0, iCol).Value / 1000000, "$#.0M") Case "CYPlus2Forecast" 'N iCol = 13 aSlide.Shapes(iCnt).TextFrame.TextRange.Text = _ Format(aCell.Offset(0, iCol).Value / 1000000, "$#.0M") Case "SalesAtMaturity" 'O iCol = 14 aSlide.Shapes(iCnt).TextFrame.TextRange.Text = _ Format(aCell.Offset(0, iCol).Value / 1000000, "$#.0M") Case "OrigLaunchTime" '? 'iCol = 14 Case "LaunchPlanInHome" ' 'icol = 15 Case "LaunchPlanInOther" ' Case "SalesPriorYR" ' End Select Next iCnt '*** For Each aShape In aSlide.Shapes Next aCell End With End Sub