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

时间:2015-04-16 21:23:30

标签: excel vba excel-2010 powerpoint powerpoint-vba

我有一个包含大约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列导入到应该放置的位置。

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

1 个答案:

答案 0 :(得分: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