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

Question

我有一个包含约400行数据的Excel文档。 它们按列排序。 例如，列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

它创建了几张幻灯片（应有的幻灯片），并将信息从A列导入到应放置的位置。

我的问题是我不知道如何将其余文本填充到应该放置的位置。

Answer 1

假设您希望将每个Excel行以相同的格式传递给单独的PPT幻灯片，则可以创建一个带有文本框或表格的幻灯片PPT，可以通过Excel VBA对其进行填充。 一旦创建了PPT幻灯片，就可以通过使用“即时”窗口获取对象名称，通过PPT中的VBA编辑器来获取名称或单元格地址（分别用于文本框或表）。 选择幻灯片中的第一个对象，然后在“ PPT立即”窗口中键入以下内容，然后按回车键。

?activewindow.Selection.shaperange.Name

我通常要做的是通过选择形状并键入要命名的名称来为形状分配名称。 然后，我切换到形状仍处于选中状态的立即窗口并键入：

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