none
Excelオートメーションで、オートシェイプ(図形)のCopy&Pasteができない RRS feed

  • 質問


  • Visual Studio2010+VB.netで、Excelワークブック内のオートシェイプをコピー&貼り付けする操作を行おうとしています。
    Excel上での手動操作では、セルの選択とコピー、貼り付けでオートシェイプがコピーされます。
    Excel VBAでは同じ動作をするプログラムが正常に動作しましたが、Excelオートメーションでは貼り付けができません。

    VB.netで正常に動作させるには、どうしたらよいのでしょうか。御教授願います。

    ’’’’VB.net コード

    Imports Microsoft.Office.Interop
    Imports System.Runtime.InteropServices
    '参照設定で、Microsoft excel 11 object libraryを参照しないと動きません。

    Class MainWindow

        'テスト用のExcelブックとして"c:\0.xls"を作成し、「1」という名前のシートのA1セルに何かオートシェイプを書き込んでおく。
        '「2」という名前の空のシートも作っておくこと。


        Private Sub MainWindow_Loaded(sender As Object, e As System.Windows.RoutedEventArgs) Handles Me.Loaded

            Dim Excel_Access0 = New ExcelAccess()

            Excel_Access0.CopyTest()

            Excel_Access0.close_excelThread()
            Excel_Access0 = Nothing
            Me.Close()

        End Sub

    End Class


    'Excelファイルを読み書きするためのクラス
    Public Class ExcelAccess
        Implements IDisposable

        Public excelAppObj As Excel.Application
        Public excelWorkBooks As Excel.Workbooks
        Public excelWorkBook As Excel.Workbook
        Public excelSheet As Excel.Worksheet
        Public ExcelFilename As String

        Private disposedValue As Boolean = False

        Public Sub New()
            excelAppObj = New Excel.Application
            excelWorkBooks = excelAppObj.Workbooks
            excelWorkBook = excelAppObj.Workbooks.Open("c:\0.xls")
        End Sub

        Public Sub CopyTest()
            '1~9行の内容をワークシート「1」と「2」にコピペする

            '操作対象ワークシート名
            Dim Sheet1 As String = "1" 'コピー元
            Dim Sheet2 As String = "2" 'コピー先

            excelWorkBook.Sheets(Sheet1).Rows("1:9").copy()

            excelWorkBook.Sheets(Sheet1).range("A10").PasteSpecial(-4104) '-4104:全て貼り付け
            excelWorkBook.Sheets(Sheet2).range("A10").PasteSpecial(-4104) '-4104:全て貼り付け

        End Sub


        'ここから下のコードは、この質問とは無関係
        Public Sub close_excelThread()
            If excelWorkBook Is Nothing Then
                GoTo L100
            End If

            Try
                excelWorkBook.Close()
                excelWorkBooks.Close()
                excelSheet = Nothing
                excelAppObj.Quit()
            Finally
                If excelSheet Is Nothing Then
                Else
                    Marshal.ReleaseComObject(excelSheet)
                End If

                Marshal.ReleaseComObject(excelWorkBook)
                Marshal.ReleaseComObject(excelWorkBooks)
                Marshal.ReleaseComObject(excelAppObj)

            End Try
    L100:
            excelAppObj = Nothing
            excelWorkBooks = Nothing
            excelWorkBook = Nothing

            GC.WaitForPendingFinalizers()
            GC.Collect()

        End Sub


        'クラスが破棄された時に.Net Frameworkで自動実行されるコード
        Protected Overrides Sub Finalize()
            Dispose(False)
            MyBase.Finalize()
        End Sub


        ' IDisposable
        Protected Overridable Sub Dispose(ByVal disposing As Boolean)
            If Not Me.disposedValue Then
                Me.close_excelThread()
            End If
            Me.disposedValue = True
        End Sub

    #Region " IDisposable Support "
        ' このコードは、破棄可能なパターンを正しく実装できるように Visual Basic によって追加されました。
        Public Sub Dispose() Implements IDisposable.Dispose
            ' このコードを変更しないでください。クリーンアップ コードを上の Dispose(ByVal disposing As Boolean) に記述します。
            Dispose(True)
            GC.SuppressFinalize(Me)
        End Sub
    #End Region

    End Class
    2017年3月9日 4:47

回答

  • Excel 2003,2013のVBAマクロで確認しましたが、PasteSpecialではオートシェイプはコピーされないのですが…

    Public Sub CopyTest()
        '1~9行の内容をワークシート「1」と「2」にコピペする
    
        '操作対象ワークシート名
        Dim Sheet1 As String = "1" 'コピー元
        Dim Sheet2 As String = "2" 'コピー先
    
        'excelWorkBook.Sheets(Sheet1).Rows("1:9").copy()
        'excelWorkBook.Sheets(Sheet1).range("A10").PasteSpecial(-4104) '-4104:全て貼り付け
        'excelWorkBook.Sheets(Sheet2).range("A10").PasteSpecial(-4104) '-4104:全て貼り付け
    
        Dim r, r1, r2 As Excel.Range
        r = excelWorkBook.Sheets(Sheet1).Rows("1:9")
        r1 = excelWorkBook.Sheets(Sheet1).range("A10")
        r2 = excelWorkBook.Sheets(Sheet2).range("A10")
    
        r.Copy(r1)
        r.Copy(r2)
    End Sub

    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    • 回答としてマーク huahi11112 2017年3月10日 7:35
    2017年3月10日 3:31

すべての返信

  • Excel 2003,2013のVBAマクロで確認しましたが、PasteSpecialではオートシェイプはコピーされないのですが…

    Public Sub CopyTest()
        '1~9行の内容をワークシート「1」と「2」にコピペする
    
        '操作対象ワークシート名
        Dim Sheet1 As String = "1" 'コピー元
        Dim Sheet2 As String = "2" 'コピー先
    
        'excelWorkBook.Sheets(Sheet1).Rows("1:9").copy()
        'excelWorkBook.Sheets(Sheet1).range("A10").PasteSpecial(-4104) '-4104:全て貼り付け
        'excelWorkBook.Sheets(Sheet2).range("A10").PasteSpecial(-4104) '-4104:全て貼り付け
    
        Dim r, r1, r2 As Excel.Range
        r = excelWorkBook.Sheets(Sheet1).Rows("1:9")
        r1 = excelWorkBook.Sheets(Sheet1).range("A10")
        r2 = excelWorkBook.Sheets(Sheet2).range("A10")
    
        r.Copy(r1)
        r.Copy(r2)
    End Sub

    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    • 回答としてマーク huahi11112 2017年3月10日 7:35
    2017年3月10日 3:31
  • 御回答ありがとうございました。

    しかし、これでは使えませんでした。カラムの幅情報がコピーされないのです。

    昨日から代替案を検討しておりまして、貼り付けたいオートシェイプと同じ外観の画像をsheet.Shapes.AddPicture()で貼り付ける方針で開発を進めております。今回御回答頂いた方法は、見送らせていただきます。

    PasteSpecialでのオートシェイプのコピー&ペーストは、Excel VBA(つまりマクロのこと)では正常動作を確認した上で投稿しています。PasteSpecialを使用したのは、ExcelオートメーションからはPasteメソッドが使用できないからです。

    Excelオートメーションで別のアプリケーションから操作した場合、コピー元と同じワークシート内ではオートシェイプが貼り付けできず、別のワークシートには1つしか貼り付けできないという動作をします。

    2017年3月10日 6:53