Question

您好，这是对此故障单的跟进：How to resolve Missing Powerpoint 15 Object Library Error

我开发了一个宏，可以在Excel 2010中将excel中的内容导出到powerpoint。当我尝试部署到Office 2010的用户时，我遇到了问题。根据SO的建议我将引用更改为后期绑定以避免版本依赖。现在可以在Office 2010上打开并运行宏，但用户仍然会看到错误消息：＆＃34;无法加载DLL＆＃34;。当我点击引用时，它说缺少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

Answer 1

请尝试使用此代码段来简化操作：

' 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是Office变量，而不是PPT特定的，因此您可能不需要更改它们。或者你可以简单地使用True和False。

如果您删除了对PPT的引用，那么检查项目是否有参考是没有意义的;它不会。如果您保留引用，用户将在不运行2010版Office时始终看到有关丢失引用的消息。

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

1 个答案: