Excel 如何解决14个Microsoft Powerpoint对象库和15个Microsoft Powerpoint对象库之间的兼容性问题

Excel 如何解决14个Microsoft Powerpoint对象库和15个Microsoft Powerpoint对象库之间的兼容性问题,excel,excel-2010,powerpoint,vba,Excel,Excel 2010,Powerpoint,Vba,您好,这是这张票的后续内容: 我开发了一个宏,可以在excel 2010中将某些内容从excel导出到powerpoint。当我试图向使用Office 2010的人员部署时,遇到了一些问题。根据SO的建议,我将引用更改为后期绑定,以避免版本依赖性。现在可以在office 2010上打开并运行宏,但用户仍会看到错误消息:“加载DLL时遇到问题”。当我点击参考资料时,上面说缺少15个Powerpoint VBA。如果我取消选中此项并选中14,它将运行,但似乎2010年的某个人每次运行宏时都必须执行此

您好,这是这张票的后续内容:

我开发了一个宏,可以在excel 2010中将某些内容从excel导出到powerpoint。当我试图向使用Office 2010的人员部署时,遇到了一些问题。根据SO的建议,我将引用更改为后期绑定,以避免版本依赖性。现在可以在office 2010上打开并运行宏,但用户仍会看到错误消息:“加载DLL时遇到问题”。当我点击参考资料时,上面说缺少15个Powerpoint VBA。如果我取消选中此项并选中14,它将运行,但似乎2010年的某个人每次运行宏时都必须执行此操作。对如何进行有什么建议吗?我尝试添加以下内容来解决此问题

1:修复引用的代码

Sub RemoveMissingReferences()
Dim Intrefcount As Integer

With ThisWorkbook.VBProject.references
    For Intrefcount = 1 To .Count
        If Left(.Item(Intrefcount).Description, 7) = "Missing" Then
             .Remove .Item(Intrefcount)
        End If
    Next Intrefcount
   End With
End Sub

2:从excel导出到PPT的实际宏

Sub CopyDataToPPTBrandPers()
Const ppLayouttitleonly = 11
Const ppPasteEnhancedMetafile = 2

Dim objWorkSheet As Worksheet
Dim objRange As Range
Dim objPPT, objslide, objPresentation, shapePPTOne As Object
Dim intLocation, intHeight, inLayout, intRefCount As Integer
Dim strRange As String
Dim boolRefExists As Boolean

Application.ScreenUpdating = False

boolRefExists = False
With ThisWorkbook.VBProject.references
    For intRefCount = 1 To .Count
        If .Item(intRefCount).Description = _
            "Microsoft PowerPoint 14.0 Object Library" Then
            boolRefExists = True
        End If
    Next intRefCount
End With

Set objPPT = CreateObject("PowerPoint.Application")

objPPT.Visible = True
inLayout = 1
strRange = "p19:y48"  '<- here
intHeight = 430

Set objPresentation = objPPT.Presentations.Add
Set objslide = objPresentation.Slides.Add(1, inLayout)
objslide.Layout = ppLayouttitleonly

With objslide.Shapes.Title
    With .TextFrame.TextRange
        .Text = "Reebok - " & Sheets("Brand Personality").Cells(3, 2)
        .Words.Font.Bold = msoTrue
        .Font.Color = RGB(255, 255, 255)
    End With
    .Fill.Visible = msoTrue
    .Fill.Solid
    .Fill.ForeColor.RGB = RGB(192, 0, 0) '160, 157, 117)
    .Height = 50
End With

Set objRange = Sheets("Brand Personality").Range(strRange)
objRange.Copy

Set shapePPTOne = objslide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile, _
    Link:=msoFalse)
DoEvents

If boolRefExists = True Then
    shapePPTOne.Left = 100
    shapePPTOne.Top = 100
    shapePPTOne.Height = intHeight    
Else
    shapePPTOne(1).Left = 220
    shapePPTOne(1).Top = 100
    shapePPTOne(1).Height = intHeight
End If

Set shapePPTOne = Nothing
'Set shapePPTTwo = Nothing
Set objRange = Nothing
Set objPPT = Nothing
Set objPresentation = Nothing
Set objslide = Nothing

Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Update Complete"

End Sub
Sub-CopyDataToPPTBrandPers()
常数ppLayouttitleonly=11
常量ppPasteEnhancedMetafile=2
将工作表设置为工作表
Dim objRange As范围
Dim objPPT、objslide、objPresentation、形状选项作为对象
Dim intLocation、IN IGHT、INLAOUT、intRefCount为整数
像字符串一样的模糊排列
Dim boolref作为布尔值存在
Application.ScreenUpdating=False
boolRefExists=False
使用ThisWorkbook.VBProject.references
对于intRefCount=1到.Count
If.Item(intRefCount).Description=_
“Microsoft PowerPoint 14.0对象库”然后
boolRefExists=True
如果结束
下一个intRefCount
以
设置objPPT=CreateObject(“PowerPoint.Application”)
objPPT.Visible=True
inLayout=1

strRange=“p19:y48”试着用这个片段来简化事情:

' PasteSpecial returns a shaperange consisting of 1 shape, so add a (1) at the end to 
' set shapePPTOne equal to the first shape in the range:
Set shapePPTOne = objslide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile, _
    Link:=msoFalse)(1)
DoEvents

Then you don't need all this stuff, just shapePPTOne.Left = xxx etc.
'If boolRefExists = True Then
    shapePPTOne.Left = 100
    shapePPTOne.Top = 100
    shapePPTOne.Height = intHeight    
'Else
'    shapePPTOne(1).Left = 220
'    shapePPTOne(1).Top = 100
'    shapePPTOne(1).Height = intHeight
'End If
IIRC、msoTrue和msoFalse都是办公室变量,不是特定于PPT的,所以您可能不需要更改它们。或者你可以简单地使用真与假


如果你删除了对PPT的引用,那么检查项目是否有引用是没有意义的;不会的。如果您保留引用,用户在不运行2010版Office时,总会看到一条消息,抱怨缺少引用。

注意,左侧命令中的#1修复引用代码超时。我无法弄清楚为什么您已经迁移到
后期绑定
,然后删除任何
引用
并保存
.xlsm
文件<代码>后期绑定
根本不需要任何引用。另外,
msoTrue
msoFalse
也是PPt变量,因此需要将其分别更改为
-1
0
。然后尝试再次扫描您的代码,我可能遗漏了其他变量。您的声明没有达到预期效果:Dim objPPT、objslide、objPresentation、shapeptone As Object创建shapeptone作为对象变量,其余作为变量。同样:Dim intLocation、Inlight、inLayout、intRefCount As Integer将intRefCount设置为整数,其余为变量。在这种情况下,这可能没有多大关系,但有时会导致模糊的错误和奇怪的结果。最好正确申报VAR。