PowerPoint 中的宏，它链接到存储在 Excel 电子表格中的数据

Question

我有一个 Excel 电子表格（比如说 objectdata.xls），用于设置不同矩形的宽度/长度。因此，电子表格有 3 列：

对象名称 对象宽度 对象长度

电子表格中定义了大约 100 个矩形

我要做的是在 PowerPoint (PP) 中运行一个宏，该宏将从电子表格中读取数据（理想情况下，此信息应存储在 PP 文件的外部，但如果需要，它可以是链接的或嵌入的PP 中的文件），然后更新我包含在 PP 文件中的矩形形状的大小。

例如在第一张幻灯片上，宏读取电子表格中的第 1 行并看到对象的宽度为 5，长度为 10，因此更新 PP 中矩形形状的大小。

谁能告诉我这是否可以做到？

谢谢。

Answer 1

使用 GetExcelData 来完成这项工作；它调用 GetExcel

Function GetExcel() As Object
'---------------------------------------------------------------------------------------
' Procedure : GetExcel
' Author    : Naresh Nichani / Steve Rindsberg
' Purpose   :
'               Check if an instance of Excel is running. If so obtain a reference to the running Excel application
'               Otherwise Create a new instance of Excel and assign the XL application reference to oXLApp object
' SR        :   Modified 2010-02-23 to ALWAYS create a new instance rather than using an existing one, so when we
'           :   close the one we open, we don't wack the user's other instances of Excel if any
' Params    :   None
' Returns   :   An Excel Application object on success, Nothing on failure
'---------------------------------------------------------------------------------------

   On Error GoTo GetExcel_ErrorHandler

    On Error Resume Next
    Err.Number = 0

    Dim oXLAPP As Object

' Comment out the following bits to force a new instance of Excel
' and leave any existing instances alone
'    Set oXLApp = GetObject(, "Excel.Application")
'    If Err.Number <> 0 Then
'        Err.Number = 0
        Set oXLAPP = CreateObject("Excel.Application")
        If Err.Number <> 0 Then
            'MsgBox "Unable to start Excel.", vbInformation, "Start Excel"
            Exit Function
        End If
'    End If

   On Error GoTo GetExcel_ErrorHandler

    If Not oXLAPP Is Nothing Then
        Set GetExcel = oXLAPP
    Else
        [MASTTBAR].rnrErrLog "modExcel:GetExcel - unable to invoke Excel instance"
    End If

    Set oXLAPP = Nothing

    Exit Function

NormalExit:
   On Error GoTo 0
   Exit Function

GetExcel_ErrorHandler:
    Resume NormalExit
End Function

Function GetExcelData(sFilename As String, _
    Optional lWorksheetIndex As Long = 1, _
    Optional sWorksheetName As String = "") As Variant
'---------------------------------------------------------------------------------------
' Purpose   : Gets the "active" data from the file/worksheet specified

    Dim oXLAPP As Object
    Dim oxlWB As Object
    Dim oxlRange As Object

    Dim x As Long
    Dim y As Long
    Dim sMsg As String

    Dim lVisibleRowCount As Long
    Dim lVisibleColCount As Long

    Dim aData() As String

   On Error GoTo GetExcelData_ErrorHandler

    Set oXLAPP = GetExcel()
    If oXLAPP Is Nothing Then
        Exit Function
    End If

    ' open the workbook read-only
    Set oxlWB = oXLAPP.Workbooks.Open(sFilename, , True)
    If oxlWB Is Nothing Then
        Exit Function
    End If

    If Len(sWorksheetName) > 0 Then
        Set oxlRange = GetUsedRange(oxlWB.Worksheets(sWorksheetName))
    Else
        Set oxlRange = GetUsedRange(oxlWB.Worksheets(lWorksheetIndex))
    End If

    If oxlRange Is Nothing Then
        Exit Function
    End If

    ' Get a count of visible rows/columns (ignore hidden rows/cols)
    For x = 1 To oxlRange.Rows.Count
        If Not oxlRange.Rows(x).Hidden Then
            lVisibleRowCount = lVisibleRowCount + 1
        End If
    Next    ' row

    For y = 1 To oxlRange.Columns.Count
        If Not oxlRange.Columns(y).Hidden Then
            lVisibleColCount = lVisibleColCount + 1
        End If
    Next

    ReDim aData(1 To lVisibleRowCount, 1 To lVisibleColCount)

    lVisibleRowCount = 0
    For x = 1 To oxlRange.Rows.Count
        If Not oxlRange.Rows(x).Hidden Then
            lVisibleRowCount = lVisibleRowCount + 1
            lVisibleColCount = 0
            For y = 1 To oxlRange.Columns.Count
                If Not oxlRange.Columns(y).Hidden Then
                    lVisibleColCount = lVisibleColCount + 1
                    aData(lVisibleRowCount, lVisibleColCount) = oxlRange.Cells(x, y).Text
                End If
            Next
        End If
    Next

    ' return data in array
    GetExcelData = aData

NormalExit:
    On Error GoTo 0

    ' Close the workbook
    If Not oxlWB Is Nothing Then
        oXLAPP.DisplayAlerts = False
        oxlWB.Close
        oXLAPP.DisplayAlerts = True
    End If

    'To Close XL application
    If Not oXLAPP Is Nothing Then
        oXLAPP.Quit
    End If

    'Set the XL Application and XL Workbook objects to Nothing
    Set oxlRange = Nothing
    Set oxlWB = Nothing
    Set oXLAPP = Nothing

    Exit Function

GetExcelData_ErrorHandler:
    Resume NormalExit

End Function

块引用 块引用enter code here

Answer 2

是的，这当然可以做到。它需要比我指尖更多的代码，你需要适应我发布的任何内容。但是请查看此处以了解您可以开始使用的示例。这些指向我维护的 PowerPoint 常见问题解答网站。不收取任何费用。

从 PowerPoint 控制 Office 应用程序（Naresh Nichani 和 Brian Reilly 着） http://www.pptfaq.com/FAQ00795.htm

从 PowerPoint 自动化 Excel。从 Excel 自动化 PowerPoint。等等。 http://www.pptfaq.com/FAQ00368.htm

我可能会通过打开 excel 文件，将内容读入数组，然后使用数组中的数据在 PPT 中做实际工作来做到这一点。

如果您在 PPT 部分需要帮助，请告诉我们。主要是编写一个类似 [aircode] 的函数：

Sub SetRectangleSize ( sRectangleName as string, sngWidth as Single, sngHeight as Single)
  Dim oShp as Shape
  Set oShp = GetShapeNamed(sRectangleName, lSlideIndex)
  If Not oShp is Nothing Then
    With oShp
        .Width = sngWidth
        .Height = sngHeight
    End With
  End If
End Sub

和

Function GetShapeNamed(sName as String, lSlideIndex as Long) as Shape
  On Error Resume Next
  Set GetShapeNamed = ActivePresentation.Slides(lSlideIndex).Shapes(sName)
  If Err.Number <> 0 Then
     ' no shape by that name on the slide; return null
     Set GetShapeNamed = Nothing
  End If
End Function  

顺便说一句，我会考虑使用标签来识别矩形而不是形状名称（这往往不太可靠）。