Visual C# で Excel をコピーする

Visual C# から Excel VBA を呼び出してコピーさせます。

"CopyMacro.xlsm" は、 適当なフォルダに入れます。今回はこの C# プログラムのカレントフォルダに入れました。

書式・数式など含めてコピーしますので、循環参照やリンク切れに注意して利用して下さい。

 

Windows10, VisualStudio2015, Excel2013 で動作確認済み

C# で Excel の Range を 書式なども含めてコピーする


C# で Excel の Range を 書式なども含めてコピーするには次のようにします。


        // Visual C# プログラムに書く内容         

        // fB = コピー元ファイルフルパス指定
    // fW = コピー元ファイル名(パスなし)
        // fS = コピー元シート名
    // fR = コピー元レンジ("A1:H13"のような形)

        // tB = コピー先ファイルフルパス指定
    // tW = コピー先ファイル名(パスなし)
        // tS = コピー先シート名
    // tR = コピー先レンジ("T5"のような形)

        public void CallMacro(string fB, string fW, string fS, string fR,
                              string tB, string tW, string tS, string tR)
        {
            // カレントディレクトリを取得する
            string stCurrentDir = System.IO.Directory.GetCurrentDirectory();
            // Excel.Application の新しいインスタンスを生成する
            var xlApp = new Microsoft.Office.Interop.Excel.Application();
            Microsoft.Office.Interop.Excel.Workbooks xlBooks;

            // xlApplication から WorkBooks を取得する
            // 既存の Excel ブックを開く
            xlBooks = xlApp.Workbooks;
            xlBooks.Open(stCurrentDir + @"\CopyMacro.xlsm");

            // Excel を表示する
            xlApp.Visible = true;
            //fExcelApp.Visible = true;
            //tExcelApp.Visible = true;

            // マクロを実行する
            // 標準モジュール内のCopyRange 実行
            xlApp.Run("CopyMacro.xlsm!CopyRange", fB,fW,fS,fR,tB,tW,tS,tR);

            //fExcelApp.Visible = false;
            //tExcelApp.Visible = false;

            // Excel を終了する
            xlApp.Quit();
            System.Runtime.InteropServices.Marshal.ReleaseComObject(xlBooks);
            System.Runtime.InteropServices.Marshal.ReleaseComObject(xlApp);
        }


' Excel VBA [ CopyMacro.xlsm ] の標準モジュールに書く内容

Option Explicit

Private Declare Function AccessibleChildren Lib "oleacc" _
    (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, _
     ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long _

Private Const CHILDID_SELF = 0&
Private Const ROLE_SYSTEM_LIST = &H21
Private Const ROLE_SYSTEM_PROPERTYPAGE = &H26
Private Const ROLE_SYSTEM_PUSHBUTTON = &H2B
Private Const ROLE_SYSTEM_WINDOW = &H9

Private Sub PasteOfficeClipboardItem(ByVal Num As Long)
'Officeクリップボードに登録されているアイテムを貼り付け
  Dim Acc As Office.IAccessible
  
  Set Acc = GetAccOfficeClipboardList
  If Acc Is Nothing Then Exit Sub
  If (Acc.accChildCount = 1) And (InStr(Acc.accName(1&), "クリップボードは空")) Then
    MsgBox "クリップボードは空です。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal
    Exit Sub
  End If
  If Num > Acc.accChildCount Then
    MsgBox "指定した番号は無効です。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal
    Exit Sub
  End If
  Acc.accDoDefaultAction Num
  Set Acc = Nothing
End Sub

Private Sub DoActionOfficeClipboard(ByVal AccObjName As String)
'Officeクリップボードコマンド実行
  Dim Acc As Office.IAccessible
  Dim Count As Long
  Dim i As Long
  
  Select Case AccObjName
    Case "すべて貼り付け", "すべてクリア"
    Case Else
      MsgBox "指定したコマンドには対応していません。" & vbCrLf &  _
      "「すべて貼り付け」か「すべてクリア」のどちらかを指定してください。", _
         vbCritical + vbSystemModal 
      Exit Sub
  End Select
  
  Application.CommandBars("Office Clipboard").Visible = True
  DoEvents
  Set Acc = Application.CommandBars("Office Clipboard")
  Set Acc = GetAcc(Acc, "Collect and Paste 2.0", ROLE_SYSTEM_WINDOW)
  Set Acc = GetAcc(Acc, "Collect and Paste 2.0", ROLE_SYSTEM_PROPERTYPAGE)
  Count = Acc.accChildCount
  If Count > 0& Then
    For i = 0 To Count
      If (Acc.accName(i) = AccObjName) And (Acc.accRole(i) = ROLE_SYSTEM_PUSHBUTTON) Then
        Acc.accDoDefaultAction i
        Exit For
      End If
    Next
  End If
  Set Acc = Nothing
End Sub

Private Sub GetOfficeClipboardList(ByRef ItemList As Variant)
'Officeクリップボードリスト取得
  Dim Acc As Office.IAccessible
  Dim Count As Long
  Dim v() As Variant
  Dim i As Long
  
  Set Acc = GetAccOfficeClipboardList
  If Acc Is Nothing Then Exit Sub
  Count = Acc.accChildCount
  If (Count = 1) And (InStr(Acc.accName(1&), "クリップボードは空")) Then
    MsgBox "クリップボードは空です。" & vbCrLf & "処理を中止します。", _
            vbCritical + vbSystemModal
    Exit Sub
  End If
  ReDim v(Count - 1)
  For i = 1 To Count
    v(i - 1) = Acc.accName(i)
  Next
  Set Acc = Nothing
  ItemList = v
End Sub

Private Function GetAccOfficeClipboardList() As Office.IAccessible
'Officeクリップボードリスト(Accessibleオブジェクト)取得
  Dim Acc As Office.IAccessible
  
  Application.CommandBars("Office Clipboard").Visible = True
  DoEvents
  Set Acc = Application.CommandBars("Office Clipboard")
  Set Acc = GetAcc(Acc, "Collect and Paste 2.0", ROLE_SYSTEM_WINDOW)
  Set Acc = GetAcc(Acc, "Collect and Paste 2.0", ROLE_SYSTEM_PROPERTYPAGE)
  Set Acc = GetAcc(Acc, "クリップボード", ROLE_SYSTEM_LIST)
  Set GetAccOfficeClipboardList = Acc
  Set Acc = Nothing
End Function

Private Function GetAcc(myAcc As Office.IAccessible, myAccName As String, _
                        myAccRole As Long) As Office.IAccessible
  Dim ReturnAcc As Office.IAccessible
  Dim ChildAcc As Office.IAccessible
  Dim List() As Variant
  Dim Count As Long
  Dim i As Long
  
  If (myAcc.accState(CHILDID_SELF) <> 32769) And _
     (myAcc.accName(CHILDID_SELF) = myAccName) And _
     (myAcc.accRole(CHILDID_SELF) = myAccRole) Then
    Set ReturnAcc = myAcc
  Else
    Count = myAcc.accChildCount
    If Count > 0& Then
      ReDim List(Count - 1&)
      If AccessibleChildren(myAcc, 0&, ByVal Count, List(0), Count) = 0& Then
        For i = LBound(List) To UBound(List)
          If TypeOf List(i) Is Office.IAccessible Then
            Set ChildAcc = List(i)
            Set ReturnAcc = GetAcc(ChildAcc, myAccName, myAccRole)
            If Not ReturnAcc Is Nothing Then Exit For
          End If
        Next
      End If
    End If
  End If
  Set GetAcc = ReturnAcc
End Function



Sub CopyRange(fBook As String, fWindow As String, fSheet As String, fRange As String, _
              tBook As String, tWindow As String, tSheet As String, tRange As String)
'
' CopyRange Macro
'   
    Workbooks.Open fBook
    Workbooks.Open tBook
    
    
    Workbooks(fWindow).Activate
    Worksheets(fSheet).Select
    Range(fRange).Select
    Selection.Copy
    
    Workbooks(tWindow).Activate
    Worksheets(tSheet).Select
    Range(tRange).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    On Error Resume Next
    ActiveWorkbook.Save
    If Err.Number > 0 Then MsgBox "保存されませんでした"
    
    DoActionOfficeClipboard "すべてクリア" ''「すべてクリア」実行

    Workbooks(fWindow).Close   
    Workbooks(tWindow).Close   
End Sub