Application.PasteSourceFormatting メソッド (Project)

レポートまたは図形のコピーを貼り付けます。コピーによってソースの書式が保持されます。

構文

expression. PasteSourceFormatting

expressionApplicationオブジェクトを表す変数 。

戻り値

ブール型 (Boolean)

貼 り付けが成功した場合は True。それ以外の場合は False。

例

次の例では、組み込みのコスト レポートをコピーし、カスタム レポートを作成し、コピーしたレポートをソースの書式設定を使用して新しいレポートに貼り付け、レポート タイトルの名前を変更します。

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

関連項目

Application オブジェクト

CopyReport メソッドShape.Copy メソッドPasteDestFormatting メソッドPasteAsPicture メソッド

サポートとフィードバック

Office VBA またはこの説明書に関するご質問やフィードバックがありますか？ サポートの受け方およびフィードバックをお寄せいただく方法のガイダンスについては、Office VBA のサポートおよびフィードバックを参照してください。