Application.PasteSourceFormatting-Methode (Project)

Fügt eine Kopie eines Berichts oder einer Form ein, wobei die Kopie die Formatierung der Quelle beibehält.

Syntax

Ausdruck. PasteSourceFormatting

expression Eine Variable, die ein Application-Objekt darstellt.

Rückgabewert

Boolean

True , wenn die Einfüge erfolgreich ist; andernfalls False.

Beispiel

Im folgenden Beispiel wird der integrierte Kostenbericht kopiert, ein benutzerdefinierter Bericht erstellt, der kopierte Bericht mithilfe der Quellformatierung in den neuen Bericht eingefügt und anschließend der Berichtstitel umbenannt.

Sub CopyCostReport()
    Dim reportName As String
    Dim newReportName As String
    Dim newReportTitle As String
    Dim myNewReport As Report
    Dim oShape As Shape
    Dim msg As String
    Dim msgBoxTitle As String
    Dim numShapes As Integer
    
    reportName = "Task Cost Overview"   ' Built-in report
    newReportName = "Task Cost Copy 2"
    msg = ""
    numShapes = 0
    
    If ActiveProject.Reports.IsPresent(reportName) Then
        ApplyReport reportName
        CopyReport
        Set myNewReport = ActiveProject.Reports.Add(newReportName)
        PasteSourceFormatting
        
        ' List the shapes in the copied report.
        For Each oShape In myNewReport.Shapes
            numShapes = numShapes + 1
            msg = msg & numShapes & ". Shape type: " & CStr(oShape.Type) _
                & ", '" & oShape.Name & "'" & vbCrLf
            
            ' Modify the report title.
            If oShape.Name = "TextBox 1" Then
                newReportTitle = "My " & oShape.TextFrame2.TextRange.Text
                With oShape.TextFrame2.TextRange
                    .Text = newReportTitle
                    .Characters.Font.Fill.ForeColor.RGB = &H60FF10 ' Bluish green.
                End With
                
                oShape.Reflection.Type = msoReflectionType2
                oShape.IncrementTop -10    ' Move the title 10 points up.
                oShape.Select
            End If
        Next oShape
        
        msgBoxTitle = "Shapes in report: '" & myNewReport.Name & "'"
                
        If numShapes > 0 Then
            MsgBox Prompt:=msg, Title:=msgBoxTitle
        Else
            MsgBox Prompt:="This report contains no shapes.", _
                Title:=msgBoxTitle
        End If
    Else
        MsgBox Prompt:="No custom report name: " & reportName, _
            Title:="ApplyReport error", Buttons:=vbExclamation
    End If
End Sub

Siehe auch

Application-Objekt

CopyReport-MethodeShape.Copy-MethodePasteDestFormatting-MethodePasteAsPicture-Methode

Support und Feedback

Haben Sie Fragen oder Feedback zu Office VBA oder zu dieser Dokumentation? Unter Office VBA-Support und Feedback finden Sie Hilfestellung zu den Möglichkeiten, wie Sie Support erhalten und Feedback abgeben können.