复制单元格内容 - Excel 2010 VBA
问题描述:
我试图完成一个相对(我认为)简单的任务。我想创建一个按钮,将活动单元格的内容复制到剪贴板。然后,我将使用crtl + v粘贴到另一个应用程序中。目标是复制excel表格内的一串文本......包括格式化和换行符。我想避免必须按F2,Crtl + shift + home,然后crtl + C。有没有办法做到这一点?复制单元格内容 - Excel 2010 VBA
旧的Crtl + C和activecell.copy没有达到正确的结果,因为它们在粘贴到另一个应用程序时摆脱了任何换行符。 TIA
答
这个怎么样。这是一个字符的方式:
Sub CopyCellContents()
'divides original cell into multiple, delimiter is line break (character 10)
'copies the individual character text and formatting
'copies result into clipboard
Dim wsSrc As Worksheet 'sheet with original cells, the ones we want to copy from
Dim wsTemp As Worksheet 'sheet with temporatily stored data, cells from here will be in clipboard
Dim intOrigChars As Integer 'count of characters in original cell
Dim intDestChars As Integer 'count of characters in destination cell (varies by rows)
Set wsSrc = Worksheets("format") 'change to suit
Set wsTemp = Worksheets("Temp") 'change to suit, create new sheet, just for purpose of temporarily storing contents of cell
With wsSrc
intDestChars = 1
'loop through all the characters in original cell; Change ".Cells(1, 1)" to suit you - use rename tool to change all of them below
For intOrigChars = 1 To .Cells(1, 1).Characters.Count
'if the character is a line break (character 10), move to next row and reset destination characters to 1
If Asc(.Cells(1, 1).Characters(intOrigChars, 1).Text) = 10 Then
rowAdd = rowAdd + 1
intDestChars = 1
Else
'copy text and formatting to temporary cells
With wsTemp.Cells(1 + rowAdd, 1).Characters(intDestChars, 1)
.Text = wsSrc.Cells(1, 1).Characters(intOrigChars, 1).Text
With .Font
.Bold = wsSrc.Cells(1, 1).Characters(intOrigChars, 1).Font.Bold
.Color = wsSrc.Cells(1, 1).Characters(intOrigChars, 1).Font.Color
.Italic = wsSrc.Cells(1, 1).Characters(intOrigChars, 1).Font.Italic
.Underline = wsSrc.Cells(1, 1).Characters(intOrigChars, 1).Font.Underline
.FontStyle = wsSrc.Cells(1, 1).Characters(intOrigChars, 1).Font.FontStyle
End With
End With
intDestChars = intDestChars + 1
End If
Next
End With 'wsSrc
'put result cells into clipboard
With wsTemp
.Range(.Cells(1, 1), .Cells(rowAdd + 1, 1)).Copy
End With
End Sub
答
使用本
Sub copy()
Dim clipboard As Object
Set clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
clipboard.SetText ActiveCell.Value
clipboard.PutInClipboard
End Sub
这似乎工作就像activecell.copy或Ctrl-C做...没有任何格式化或换行符。我错过了什么吗? – 2015-04-01 07:12:34
@MikeL尝试将@Vasily的代码中的ActiveCell.Value更改为'ActiveCell.Text' – 2015-04-01 09:02:34
@BranislavKollár尝试切换到activecell.text,但剪贴板中仍然有相同的结果(未格式化) – 2015-04-02 02:56:37