Método Application.PasteSourceFormatting (Project)

Cola uma cópia de um relatório ou uma forma, em que a cópia mantém a formatação da origem.

Sintaxe

expression. PasteSourceFormatting

expressão Uma variável que representa um Aplicativo objeto.

Valor de retorno

Boolean

True se a pasta for bem-sucedida; caso contrário, False.

Exemplo

O exemplo a seguir copia o Relatório de Custo interno, cria um relatório personalizado, cola o relatório copiado no novo relatório usando a formatação de origem e renomeia o título do relatório.

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

Confira também

Objeto de Aplicativo

Método CopyReportShape.CopyPasteDestFormatting MethodPasteAsPicture Method

Suporte e comentários

Tem dúvidas ou quer enviar comentários sobre o VBA para Office ou sobre esta documentação? Confira Suporte e comentários sobre o VBA para Office a fim de obter orientação sobre as maneiras pelas quais você pode receber suporte e fornecer comentários.