在PPT中选择一个文本框并将数据导出到Excel文件

时间:2015-10-12 11:54:27

标签: vba excel-vba powerpoint-vba excel

我不熟悉编码并尝试编写代码以将数据从powerpoint中的选定文本框导出到excel文件。我希望程序要求用户选择文本框,然后将此文本框中的数据导出到excel文件。任何线索或帮助将不胜感激。

1 个答案:

答案 0 :(得分:0)

首先,您可以更轻松地检测文本框是否被选中,并且如果没有,则要求用户这样做,因为“要求用户选择文本框”意味着使用必须的自定义表单设置为无模式,以便在用户与演示文稿交互时保持打开状态。

所以,假设这没关系,这将让你前进:

Option Explicit

Public Sub CopyTextBoxTextToExcel()
  Dim oShp As Shape
  With ActiveWindow.Selection
    ' If text is selected, select the parent shape (note : you'll need to adjust for Notes pane)
    If .Type = ppSelectionText Then .ShapeRange(1).Select
    ' If selection isn't a shape, help the user
    If Not .Type = ppSelectionShapes Then GoTo SelectMsg
    ' If more than one shape selected, help the user
    If Not .ShapeRange.Count = 1 Then GoTo SelectMsg
    ' If the shape doesn't have a textframe, help the user
    If Not .ShapeRange(1).HasTextFrame Then GoTo SelectMsg
    ' If the shape doesn't have any text, help the user
    If .ShapeRange(1).TextFrame.TextRange.Text = "" Then GoTo SelectMsg
    ' If all checks are ok, set a reference to the shape
    Set oShp = .ShapeRange(1)
  End With

  Dim myText As String
  myText = oShp.TextFrame.TextRange.Text

  ' Create an instance of Excel, using late binding to avoid reference library compatibility issues
  ' You can add a refernece to Microsoft Excel under Tools / References in order to use Intellisence during developemnt
  ' and then switch back to late binding for deployment.
  Dim oExcel As Object ' Use "As Excel.Application" when usign Early Binding
  Set oExcel = CreateObject("Excel.Application")

  ' Create a new workbook
  Dim oWB As Object ' Use "As Workbook" when using Early Binding
  Set oWB = oExcel.Workbooks.Add

  oExcel.Visible = True

  ' Copy the text to a cell in the first sheet of the workbook
  oWB.Worksheets(1).Cells(1, 1) = myText

  ' Clean up
  Set oExcel = Nothing: Set oWB = Nothing
  Exit Sub

SelectMsg:
  MsgBox "Please select a single shape containing some text first.", vbInformation + vbOKOnly, "Macro by http://youpresent.co.uk/"
End Sub