複製單元格內容 - Excel 2010 VBA

Question

我試圖完成一個相對（我認爲）簡單的任務。我想創建一個按鈕，將活動單元格的內容複製到剪貼板。然後，我將使用crtl + v粘貼到另一個應用程序中。目標是複製excel表格內的一串文本......包括格式化和換行符。我想避免必須按F2，Crtl + shift + home，然後crtl + C。有沒有辦法做到這一點？

舊的Crtl + C和activecell.copy沒有達到正確的結果，因爲它們在粘貼到另一個應用程序時擺脫了任何換行符。 TIA

Answer 1

這個怎麼樣。這是一個字符的方式：

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 

Answer 2

使用本

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