经常用Excel的人，应该会经常需要把Excel里的数据复制到Word等其他软件中，复制过去经常会碰上格式上的问题。
还有时候需要复制一小块单元格区域，可是复制过去可能就是一个表格，或者是被Tab符号分隔开的内容，并不是真正需要的：
默认从Excel中复制的数据，（如果是复制到Word这类支持表格的软件，会复制表格过去，这个时候还可以进一步转换为文本），列与列之间是使用Tab连接，上一行与下一行是使用换行符连接。
如果列之间的连接符Tab和行之间的连接符换行符可以自定义就好了，那么，我们来实现这么一个复制的功能：
首先在customUI.xml中增加代码：
代码语言：javascript复制 <box id="boxCopy" boxStyle="vertical" visible="true">
<editBox id="rbtxtRowChar" label="行连接字符:" imageMso="OutlineWeightGallery" keytip="R" sizeString="123456" onChange="rbtxtRowChar_onChange" getText="rbtxtRowChar_getText"/>
<editBox id="rbtxtColChar" label="列连接字符:" imageMso="TableHeight" keytip="C" sizeString="123456" onChange="rbtxtColChar_onChange" getText="rbtxtColChar_getText"/>
<button id="rbbtnCopyText" label="复制 " size="large" supertip="复制并连接单元格的Text。" onAction="rbbtnCopyText" imageMso="SizeToFit"/>
</box>回调函数：
代码语言：javascript复制Sub rbtxtRowChar_getText(control As IRibbonControl, text)
text = "newline"
strRowChar = CheckChar(VBA.CStr(text))
End Sub
Sub rbtxtColChar_getText(control As IRibbonControl, text)
text = "、"
strColChar = CheckChar(VBA.CStr(text))
End Sub
Sub rbtxtRowChar_onChange(control As IRibbonControl, text As String)
strRowChar = CheckChar(text)
End Sub
Sub rbtxtColChar_onChange(control As IRibbonControl, text As String)
strColChar = CheckChar(text)
End Sub
Private Function CheckChar(text As String) As String
If VBA.LCase$(text) = "newline" Then
CheckChar = vbNewLine
Else
CheckChar = text
End If
End Function
Sub rbbtnCopyText(control As IRibbonControl)
MRange.CopyText strRowChar, strColChar
End Sub因为我们要自定义列之间的连接符和行之间的连接符，所以需要在MRibbon模块顶部声明2个变量：
代码语言：javascript复制Private strRowChar As String
Private strColChar As String因为换行符不大方便输入，所以设置了一个CheckChar函数，检查如果输入的是文本newline，就会把连接符替换为真正的换行符。
函数实现：
代码语言：javascript复制Sub CopyText(strRowChar As String, strColChar As String)
Dim rng As Range
Dim str As String
Dim iRow As Long, iCol As Long
Dim iRows As Long, iCols As Long
Dim arrCols() As String
Dim arrStr() As String
'确保选中的是单元格
If VBA.TypeName(Selection) = "Range" Then
Set rng = Selection
If rng.Cells.Count > 1 Then
'选择的单元格范围的行数
iRows = rng.Rows.Count
'选择的单元格范围的列数
iCols = rng.Columns.Count
'保存连接后每一行的内容
ReDim arrStr(iRows - 1) As String
'记录列单元格的Text
ReDim arrCols(iCols - 1) As String
For iRow = 0 To iRows - 1
For iCol = 0 To iCols - 1
'记录列单元格的Text，不使用Value属性的目的是因为很多时候Excel的数字会设置特殊格式
arrCols(iCol) = rng.Cells(iRow 1, iCol 1).text
Next
'将列单元格的Text连接起来，并存放到arrStr中
arrStr(iRow) = VBA.Join(arrCols, strColChar)
Next
'将连接后每一行的内容连接起来
str = VBA.Join(arrStr, strRowChar)
Else
str = VBA.CStr(rng.text)
End If
'复制文本到剪贴板
SetClipText str
End If
End SubSetClipText函数是一个比较常用的函数，所以可以放到VBAProject文件夹里的vbapFunc.xlam里，然后常用功能加载宏通过工具-引用来使用这个文件：
代码语言：javascript复制Sub SetClipText(str As String)
Dim objData As Object
Set objData = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
With objData
.SetText str '设置文本
.PutInClipboard
End With
Set objData = Nothing
End Sub
