Question

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

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

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

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

E.g。在幻灯片一中，宏读取spreadhseet中的第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

块引用 BLOCKQUOTE enter code here

Answer 2

是的，这肯定可以做到。它需要的代码比我手指上的代码要多一些，你需要适应我发布的任何内容。但是看看这里可以开始的例子。这些指向我维护的PowerPoint FAQ网站。什么都不收费。

从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

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

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

2 个答案: