|
■No89981 (イエメン さん) に返信
> VBに翻訳してみたのですが、
これでどうでしょう。
Option Explicit On
Imports System.Runtime.InteropServices
Public Class Form1
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim oldCursor = Cursor.Current
Cursor.Current = Cursors.WaitCursor
' クリップボードの内容確認
Dim cb = Clipboard.GetDataObject()
Dim fmt = cb.GetFormats(False).FirstOrDefault(Function(f) f Like "Biff#")
If String.IsNullOrEmpty(fmt) Then
' Excel 書式ではないので、そのまま貼り付け
RichTextBox1.Paste()
Else
Dim oldCaption = Text
Text = "Excel 書式の取得中..."
' Excel 書式を維持するため、Word 経由で貼り付け
Dim wApp As Object = Nothing
Dim wDocs As Object = Nothing
Dim wDoc As Object = Nothing
Dim wRng As Object = Nothing
Try
wApp = CreateObject("Word.Application")
wDocs = CallByName(wApp, "Documents", CallType.Get)
wDoc = CallByName(wDocs, "Add", CallType.Method)
wRng = CallByName(wDoc, "Range", CallType.Method)
CallByName(wRng, "PasteExcelTable", CallType.Method, False, False, False)
CallByName(wRng, "Copy", CallType.Method)
Try
RichTextBox1.Paste(DataFormats.GetFormat(DataFormats.Rtf))
Catch
RichTextBox1.Paste()
End Try
Catch
Finally
If wRng IsNot Nothing AndAlso Marshal.IsComObject(wRng) Then Marshal.ReleaseComObject(wRng)
If wDoc IsNot Nothing AndAlso Marshal.IsComObject(wDoc) Then Marshal.ReleaseComObject(wDoc)
If wDocs IsNot Nothing AndAlso Marshal.IsComObject(wDocs) Then Marshal.ReleaseComObject(wDocs)
If wApp IsNot Nothing AndAlso Marshal.IsComObject(wApp) Then
CallByName(wApp, "Quit", CallType.Method, False)
Marshal.FinalReleaseComObject(wApp)
End If
End Try
Text = oldCaption
End If
Cursor.Current = oldCursor
End Sub
End Class
|