PowerPoint中的宏鏈接到存儲在Excel電子表格中的數據

Question

我有一個用於設置不同矩形的寬度/長度的Excel電子表格（比方說objectdata.xls）。因此，電子表格有3列：

對象名稱 對象寬度 對象長度

有大約在電子表格中定義的100個矩形

什麼，我試圖做的是運行在PowerPoint中的宏（ PP），它將從電子表格中讀取數據（理想情況下，該信息應該存儲在PP文件的外部，但如果需要的話，它可能是PP中的鏈接或嵌入文件），然後更新我包含的矩形形狀的大小在PP文件中。

E.g.在幻燈片1上，宏讀取了spreadhseet中的第1行，並看到對象寬度爲5，長度爲10，因此更新了PP中矩形形狀的大小。

任何人都可以告訴我這是否可以做到？

謝謝。

Answer 1

是的，這當然可以做到。它需要比我手指尖更多的代碼，並且需要適應我發佈的任何內容。但在這裏看看你可以開始的例子。這些指向我維護的PowerPoint FAQ網站。不收取任何費用。從PowerPoint

控制Office應用程序（由納雷什Nichani和布賴恩·賴利） http://www.pptfaq.com/FAQ00795.htm

自動化Excel從PowerPoint。從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 

順便說一句，我會考慮使用標籤來識別矩形，而不是形狀的名稱（這往往不太可靠）。

Answer 2

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