PowerPoint中的宏，链接到Excel电子表格中存储的数据
我有一个Excel电子表格（比如objectdata.xls），用于设置不同矩形的宽度/长度。因此，电子表格有3列： 对象名 对象宽度 对象长度 电子表格中定义了大约100个矩形 我试图做的是在PowerPoint（PP）中运行一个宏，该宏将从电子表格中读取数据（理想情况下，该信息应存储在PP文件外部，但如果需要，它可以是PP中的链接或嵌入文件），然后更新我在PP文件中包含的矩形形状的大小 例如，在幻灯片1上，宏读取spreadhseet中的第1行，并看到对象宽度为5，长度为10，因此更新PP中矩形形状的大小 有人能告诉我这是否可以做到吗PowerPoint中的宏，链接到Excel电子表格中存储的数据,excel,vba,powerpoint,Excel,Vba,Powerpoint,我有一个Excel电子表格（比如objectdata.xls），用于设置不同矩形的宽度/长度。因此，电子表格有3列： 对象名 对象宽度 对象长度 电子表格中定义了大约100个矩形 我试图做的是在PowerPoint（PP）中运行一个宏，该宏将从电子表格中读取数据（理想情况下，该信息应存储在PP文件外部，但如果需要，它可以是PP中的链接或嵌入文件），然后更新我在PP文件中包含的矩形形状的大小 例如，在幻灯片1上，宏读取spreadhseet中的第1行，并看到对象宽度为5，长度为10，因此更新PP中
谢谢。是的，这当然可以做到。它需要比我手边的代码多一点的代码，你需要修改我发布的任何内容。但是，看看这里的例子，你可以开始。这些指向我维护的PowerPoint常见问题解答网站。不收任何费用 从PowerPoint控制Office应用程序（由Naresh Nichani和Brian Reilly编写） 从PowerPoint自动化Excel。从Excel自动化PowerPoint。等等 我可能会打开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
函数getShapeName（sName为字符串，lSlideIndex为长）为形状
出错时继续下一步
设置getShapeName=ActivePresentation.Slides（lSlideIndex）.Shapes（sName）
如果错误号为0，则
“幻灯片上没有这个名字的形状；返回空
设置GetShapeName=Nothing
如果结束
端函数
顺便说一下，我会考虑使用标签来识别矩形而不是形状名称（这往往是不可靠的）。p> 使用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
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