我有一个RichTextFormat文本框,而不是包含多行,粗体,下划线和斜体文本。我需要将文本和fontstyle都粘贴到Excel单元格中,因此“SAMPLE”仍然是“SAMPLE”而不是“SAMPLE”或“SAMPLE \ b0 \ par”。
我目前试过
ExcelApp.Range("C2").Value = RTFTB.Rtf
那给了我
{\ rtf1 \ ansi \ ansicpg1252 \ deff0 \ deflang1036 {\ fonttbl {\ f0 \ fnil \ fcharset0 Calibri;}} \ viewkind4 \ uc1 \ pard \ b \ f0 \ fs23 SAMPLE BOLD \ b0 \ par \ par \ i SAMPLE ITALIC \ i0 \ par \ par \ ul SAMPLE UNDERLINE \ par \ par \ ulnone SAMPLE NORMAL \ par}
(RTF代码)
和
ExcelApp.Range("C2").Value = RTFTB.Text
那给了我
样品大胆
样本信息
样本在线
样本正常
(没有fontstyle)
使用剪贴板传输信息不是我想提出的解决方案。但是,我知道如果不将RTF转换为一系列UI自动化命令来模拟将文本添加到Excel然后格式化,我就无法实现目标。
可以使用以下方法将RTF作为Html放置在剪贴板上。它在可编辑模式下使用Webbrowser
控件将剪贴板的RTF格式转换为Html。然后将Html放在剪贴板上。
整个顺序是:
...
Public Shared Sub RtfToHtmlClipboard(rtf As String)
Clipboard.SetData(DataFormats.Rtf, rtf)
Dim browser As New WebBrowser
AddHandler browser.DocumentCompleted, Sub(sender As Object, e As WebBrowserDocumentCompletedEventArgs)
Dim wb As WebBrowser = CType(sender, WebBrowser)
wb.Document.ExecCommand("Paste", False, Nothing)
wb.Document.ExecCommand("SelectAll", False, Nothing)
wb.Document.ExecCommand("Copy", False, Nothing)
wb.Dispose()
End Sub
browser.DocumentText = "<html><body contenteditable=""true""></body></html>"
End Sub
编辑:
我使用上面的方法将RTF作为HTML放在剪贴板上供用户手动粘贴。因此,我没有考虑使用某些时间敏感的用例(例如Excel自动化)的含义。
对于自动化情况,最好不要每次都创建控件。更进一步,似乎在通过自动化(可能与Office剪贴板相关?)粘贴到Excel时还有其他机制可以重新确认我不喜欢使用剪贴板。
但是,我发现以下工作可以将格式化的RTF复制到Excel。我的Office版本很古老(2007),所以希望这仍适用于较新版本。创建一个新的WinForm应用程序并使用以下内容替换Form1.VB内容以进行测试。在运行代码时,单击“Excecute”按钮创建Excel实例并将一些格式化RTF粘贴到其中。
Imports Excel = Microsoft.Office.Interop.Excel
Public Class Form1
Private WithEvents rtb As RichTextBox
Private WithEvents btnExecute As Button
Private editableBrowser As WebBrowser
Public Sub New()
InitializeComponent()
Setup()
End Sub
Private Sub Setup()
editableBrowser = New WebBrowser With {
.DocumentText = "<html><body contenteditable=""true""></body></html>"
}
btnExecute = New System.Windows.Forms.Button()
rtb = New System.Windows.Forms.RichTextBox()
SuspendLayout()
btnExecute.Location = New System.Drawing.Point(580, 20)
btnExecute.Size = New System.Drawing.Size(135, 50)
btnExecute.TabIndex = 0
btnExecute.Text = "Execute"
btnExecute.UseVisualStyleBackColor = True
AddHandler btnExecute.Click, AddressOf btnExecute_Click
rtb.Location = New System.Drawing.Point(20, 20)
rtb.Size = New System.Drawing.Size(450, 350)
rtb.TabIndex = 1
ClientSize = New System.Drawing.Size(800, 450)
Controls.Add(Me.rtb)
Controls.Add(Me.btnExecute)
ResumeLayout()
End Sub
Private Sub btnExecute_Click(sender As Object, e As EventArgs)
ExcelWork()
COMCleanUp()
End Sub
Private Function GetRTF1() As String
rtb.Clear()
' add some text and format it.
Dim formattedText As String = "some sample rtf"
rtb.Text = "This is " & formattedText & " to format and copy."
rtb.CreateControl()
rtb.SelectionStart = rtb.Find(formattedText)
rtb.SelectionLength = formattedText.Length
rtb.SelectionColor = Color.Red
rtb.SelectionFont = New Font(Font.FontFamily, Font.Size + 2.0F, FontStyle.Bold)
Return rtb.Rtf
End Function
Sub ExcelWork()
Dim app As New Excel.Application
Dim wb As Excel.Workbook = app.Workbooks.Add()
Dim rng As Excel.Range = DirectCast(wb.Worksheets(1), Excel.Worksheet).Range("A1")
PlaceRtfFAsHtmlOnClipboard(GetRTF1)
' for some reason rng.PasteSpecial just pastes as
' unformatted text. manual pasting results in formatted
' text.
' The Worsheet.Paste method as well as the Worsheet.PasteSpecial
' methods will paste the Clipboard HTML format
rng.Worksheet.PasteSpecial(Format:="HTML")
'rng.Worksheet.Paste(rng)
wb.Saved = True
app.Visible = True ' hand control over to user
app.UserControl = True
End Sub
Private Sub PlaceRtfFAsHtmlOnClipboard(rtf As String)
' Clear the browser
editableBrowser.Document.ExecCommand("SelectAll", False, Nothing)
editableBrowser.Document.ExecCommand("Cut", False, Nothing)
' put rtf on clipboard
Clipboard.SetData(DataFormats.Rtf, rtf)
' and paste to the editable broswer
editableBrowser.Document.ExecCommand("Paste", False, Nothing)
editableBrowser.Document.ExecCommand("SelectAll", False, Nothing)
' copy the html to the Clipboard
editableBrowser.Document.ExecCommand("Copy", False, Nothing)
End Sub
Private Sub COMCleanUp()
Do
GC.Collect()
GC.WaitForPendingFinalizers()
Loop While System.Runtime.InteropServices.Marshal.AreComObjectsAvailableForCleanup
End Sub
End Class
我最终没有将RTF转换为HTML到Excel的解决方案,因为我没有达到要求的技能
相反,我去了这个:
它并不完美,因为它变成了图像,而不是文本,但至少它是有效的。
这是我的代码:
'Phase 1 : Copy the RichTextBox
TbRTF.SelectAll()
TbRTF.Copy()
Clipboard.SetData(DataFormats.Rtf, TbRTF.Rtf)
'Prepare phase 2 : Declare variables
Dim aDoc As Word.Document = WordApp.Documents.Open("a blank word file.docx")
Dim TheRange As Word.Range = aDoc.ActiveWindow.Selection.Range
'Phase 2 : Paste into Word
WordApp.Visible = False
TheRange.WholeStory()
TheRange.Paste()
'Phase 3 : Copy from Word
TheRange.WholeStory()
WordApp.ActiveDocument.Select()
WordApp.Selection.Copy()
'Phase 3.5 : Close Word
aDoc.Close()
WordApp.Quit()
'Phase 4 : Paste into Excel
ExcelApp.Range("D" & r).PasteSpecial()
'Phase 4.5 : Close Excel
Classeur.SaveAs("FinishedExcelFile.xlsx")
Classeur.Close()
ExcelApp.Quit()