0

Excel に入力されたデータに基づいてブリーフィング テンプレートを作成するマクロに取り組んでいます。

エラーが表示されます: ActiveX コンポーネントはオブジェクトを作成できないか、このオブジェクトへの参照を返すことができません (エラー 429)

それらはいくつかのスライドで作成する必要があるさまざまなオブジェクトであるため、Excel ファイル内で設定されたいくつかの設定に基づいて、各オブジェクトに再利用できるサブルーチンを作成しました。

実行するサブルーチンです

貼り付け関数自体でエラーが発生し、その行内の変数にカーソルを合わせると、必要な正しい値が得られます。私はそれを単独でテストしましたが、受け取った値で問題なく動作します。また、値が Excel からコピーされたものであることを確認します。

私はこれに途方に暮れています。

Private Sub AddShape(vSummary As Boolean, vSheet As String, vRange As String, vFirstSlide As Integer, vLastSlide As Integer, vTop As Double, vLeft As Double)
Dim Sld As Integer
'Copy specified cells
    WB.Sheets(vSheet).Range(vRange).Copy
'Paste to first required slide for the specified cell group
    ActivePresentation.Slides(vFirstSlide).Shapes.PasteSpecial (ppPasteEnhancedMetafile)
'Set the specified top position
    ActiveWindow.Selection.ShapeRange.Top = (vTop * vDPI)
'Center everything before we begin
    ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
'Determine if Left position needs set'
    If vLeft Then
       ActiveWindow.Selection.ShapeRange.Left = (vLeft * vDPI)
    End If
'If contents is a Summary
    If vSummary Then
'While we still have it selected
        With ActiveWindow.Selection.ShapeRange
            .LockAspectRatio = msoTrue  'Lock Aspect Ratio
            .Width = (10 * vDPI)        'Reszie to fit slide'
            .Ungroup                    'Ungroup to make it easier to edit manually'
        End With
    Else
        'Ungroup to make it easier to edit manually then copy it to paste it to all the required slides
        ActiveWindow.Selection.ShapeRange.Ungroup.Copy
        'We pasted one already so we need to set the new first slide to the second in the series of slides to recieve the current content
        vFirstSlide = vFirstSlide + 1
        'For the specified remaineder of the slides we paste the contents we just copied.
        'NOTE: this only works if the contents are to be placed on a concurrent set of slides. this will break if the content you are adding requires random placements in the templates
        For Sld = vFirstSlide To vLastSlide
            ActivePresentation.Slides(Sld).Shapes.Paste
        Next Sld
    End If
End Sub

次のサブルーチンから呼び出しています

Sub BuildTemplate()

'Set Global Variables
Set WB = Workbooks("tool.xlsm")             'Set this to the name of the excel file
Set Settings = WB.Sheets("SETTINGS")        'Set this to the name of the settings tab
Set Build = WB.Sheets("BUILD")              'Set this to the name of the build tab
Set Entry = WB.Sheets("ENTRY")              'Set this to the name of the entry tab

    vDPI = Settings.Cells(2, "B").Value

'Adjust column sizes
    Build.Columns(2).AutoFit
    Build.Columns(4).AutoFit
    Build.Columns(6).AutoFit
    Build.Columns(8).AutoFit

'Create Template Files
MoveFiles
'Open newly created Template File
Dim PPT As PowerPoint.Application
Set PPT = New PowerPoint.Application
    PPT.Visible = True
    PPT.Presentations.Open Filename:=vNewPrimaryTemplatePath
'Add Title Block
Call AddShape(False, "BUILD", CStr(Settings.Range("E2")), CInt(Settings.Range("E3")), CInt(Settings.Range("E4")), CDbl(Settings.Range("E5")), CDbl(Settings.Range("E6")))

'Add Delivery Block
Call AddShape(False, "BUILD", CStr(Settings.Range("E9")), CInt(Settings.Range("E10")), CInt(Settings.Range("E11")), CDbl(Settings.Range("E12")), CDbl(Settings.Range("E13")))

'Add Address Block
Call AddShape(False, "BUILD", CStr(Settings.Range("E16")), CInt(Settings.Range("E17")), CInt(Settings.Range("E18")), CDbl(Settings.Range("E19")), CDbl(Settings.Range("E20")))

'Add Items
Call AddShape(False, "BUILD", CStr(Settings.Range("H2")), CInt(Settings.Range("H16")), CInt(Settings.Range("H17")), CDbl(Settings.Range("H12")), CDbl(Settings.Range("H10")))
Call AddShape(False, "BUILD", CStr(Settings.Range("H3")), CInt(Settings.Range("H16")), CInt(Settings.Range("H17")), CDbl(Settings.Range("H13")), CDbl(Settings.Range("H10")))
Call AddShape(False, "BUILD", CStr(Settings.Range("H4")), CInt(Settings.Range("H16")), CInt(Settings.Range("H17")), CDbl(Settings.Range("H14")), CDbl(Settings.Range("H10")))
Call AddShape(False, "BUILD", CStr(Settings.Range("H5")), CInt(Settings.Range("H16")), CInt(Settings.Range("H17")), CDbl(Settings.Range("H15")), CDbl(Settings.Range("H10")))
Call AddShape(False, "BUILD", CStr(Settings.Range("H6")), CInt(Settings.Range("H16")), CInt(Settings.Range("H17")), CDbl(Settings.Range("H12")), CDbl(Settings.Range("H11")))
Call AddShape(False, "BUILD", CStr(Settings.Range("H7")), CInt(Settings.Range("H16")), CInt(Settings.Range("H17")), CDbl(Settings.Range("H13")), CDbl(Settings.Range("H11")))
Call AddShape(False, "BUILD", CStr(Settings.Range("H8")), CInt(Settings.Range("H16")), CInt(Settings.Range("H17")), CDbl(Settings.Range("H14")), CDbl(Settings.Range("H11")))
Call AddShape(False, "BUILD", CStr(Settings.Range("H9")), CInt(Settings.Range("H16")), CInt(Settings.Range("H17")), CDbl(Settings.Range("H15")), CDbl(Settings.Range("H11")))

'Add Summaries
    AddSummary

'Save & Close
    ActivePresentation.SaveAs Filename:=vNewPrimaryTemplatePath, FileFormat:=ppSaveAsDefault
    ActivePresentation.Close

End Sub
4

1 に答える 1

1

私はそれをすべて理解し、うまく機能させることができました。

サブプロシージャ内の ActivePresentation が PowerPoint アプリケーションにアクセスできなかったのはスコープの問題でした。PPT オブジェクトをグローバルにし、それをアクティブ プレゼンテーションの前で使用することで、それが機能するようになりました。

それらは、ElectricLlama が指摘したように、いくつかのオブジェクトの問題でした。これがサブルーチンの最終的な書き直しです

Private Sub AddShape(vSummary As Boolean, vSheet As String, vRange As String, Optional vFirstSlide As Integer, Optional vLastSlide As Integer, Optional vTop As Double, Optional vLeft As Variant = "Centered")
Dim Sld As Integer
Dim oSlide As Slide
Dim oShape As Object

'Copy specified cells
    WB.Sheets(vSheet).Range(vRange).Copy
'Paste to first required slide for the specified cell group
Set oSlide = PPT.ActivePresentation.Slides(vFirstSlide)
Set oShape = oSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile)
'Center everything before we begin
    oShape.Align msoAlignCenters, True
    oShape.Align msoAlignMiddles, True
'Set the specified top position
    oShape.Top = (vTop * vDPI)
'Determine if Left position needs set'
    If vLeft = "Centered" Then
        oShape.Align msoAlignCenters, True
    Else
        oShape.Left = (vLeft * vDPI)
    End If
'If contents is a Summary
    If vSummary Then
'While we still have it selected
        With oShape
            .LockAspectRatio = msoTrue  'Lock Aspect Ratio
            .Width = (10 * vDPI)        'Reszie to fit slide'
            .Ungroup                    'Ungroup to make it easier to edit manually'
        End With
    Else
        'Ungroup to make it easier to edit manually then copy it to paste it to all the required slides
        oShape.Ungroup.Copy
        'We pasted one already so we need to set the new first slide to the second in the series of slides to recieve the current content
        vFirstSlide = vFirstSlide + 1
        'For the specified remaineder of the slides we paste the contents we just copied.
        'NOTE: this only works if the contents are to be placed on a concurrent set of slides. this will break if the content you are adding requires random placements in the templates
        For Sld = vFirstSlide To vLastSlide
            PPT.ActivePresentation.Slides(Sld).Shapes.Paste
        Next Sld
    End If

End Sub
于 2013-03-24T09:12:06.017 に答える