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

Macro in PowerPoint which links to data stored in an Excel Spreadsheet

提问by user1001522

I have an Excel Spreadsheet (let's say objectdata.xls) which is used to set the widths/lengths of different rectangles. The spreadsheet therefore has 3 columns:

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

Object Name Object Width Object Length

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

There are approx 100 rectangles defined in the Spreadsheet

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

What i am try to do is run a macro in a PowerPoint (PP) which will read the data from the Spreadsheet (ideally this info should be stored external to the PP file but if need be it could be a linked or embedded file within PP) and then update the size of the rectangle shapes that I have included in the PP file.

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

E.g. on slide one, the macro reads row 1 in the spreadhseet and sees that the object width is 5 and length is 10, and so updates the size of the rectangle shape in the PP.

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

Can anyone tell me if this can be done?

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

Thanks.

谢谢。

回答by Steve Rindsberg

Use GetExcelData to do the work; it calls GetExcel

使用 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

Blockquote Blockquoteenter code here

块引用块引用enter code here

回答by Steve Rindsberg

Yes, this can certainly be done. It takes a bit more code than I have at the tip of my fingers and you'd need to adapt whatever I posted. But have a look here for examples you can start with. These point to the PowerPoint FAQ site that I maintain. No charge for anything.

是的，这当然可以做到。它需要的代码比我的指尖多一点，你需要调整我发布的任何内容。但是看看这里的例子，你可以开始。这些指向我维护的 PowerPoint 常见问题解答站点。不收取任何费用。

Controlling Office Applications from PowerPoint (by Naresh Nichani and Brian Reilly) http://www.pptfaq.com/FAQ00795.htm

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

Automate Excel from PowerPoint. Automate PowerPoint from Excel. And so on. http://www.pptfaq.com/FAQ00368.htm

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

I'd probably do this by opening the excel file, reading the contents into an array, then using the data from the array to do the actual work in PPT.

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

If you need help with the PPT part, let us know. It'd mostly be a matter of writing a function like [aircode]:

如果您在 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

And

和

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  

Incidentally, I would consider using tags to identify the rectangles rather than shape names (which tend to be less reliable).

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