复制单元格内容 - Excel 2010 VBA

Question

我正在尝试完成一个（我认为）相对简单的任务。我想创建一个按钮，将活动单元格的内容复制到剪贴板。然后我将使用 crtl+v 粘贴到另一个应用程序中。目标是复制 excel sheet... 内的一串文本，包括格式和换行符。我想避免必须按 F2、Crtl+shift+home，然后再按 crtl+C。有没有办法做到这一点？

普通的旧 Crtl+C 和 activecell.copy 无法获得正确的结果，因为它们在粘贴到另一个应用程序时消除了任何换行符。 TIA

Answer 1

使用这个

Sub copy()
    Dim clipboard As Object
    Set clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    clipboard.SetText ActiveCell.Value
    clipboard.PutInClipboard
End Sub

Answer 2

这个怎么样。这是一个字符一个字符的方法：

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

复制单元格内容 - Excel 2010 VBA

Copy Cell Contents - Excel 2010 VBA

vba

excel

excel-2010

spreadsheet