解决excel复制出的单元格数据粘贴到微信中时默认变为图片问题

解决excel复制出的单元格数据粘贴到微信中时默认变为图片问题。

需将代码保存到personal.XLSB 个人宏工作簿中，并为其建立自定义选项卡。相关操作参见创建个人宏工作簿。

建立自定义选项卡具体操作如下：

1、点击“文件”-“选项”-“自定义功能区”，在界面右下方点击“新建选项卡”，然后，可以在“自定义功能区”右侧看到新生成了一个选项卡，名为“新建选项卡（自定义）”。

2、右键单击新生成的“新建选项卡（自定义）”，点击“重命名”，可以为新生成的选项卡起一个名字，如“Excel工具箱”。新建选项卡的子菜单名为“新建组（自定义）”，使用同样的方法可以为新建组命名，这里将其命名为“格式”。

3、点击选中“格式（自定义）”，然后，点击界面左侧的下拉菜单，选择“宏”，然后将滑动块拉到最底端，点击「getCellsInfo」，然后选中「格式（自定义）」，点击「添加(A)>>」，该功能即被添加进「格式（自定义）」内。

注意，命令按钮只能被添加进「组」，因此，这一步需要选择「组」然后再点击「添加(A)>>」。

4、将命令添加进新建组后，可以右键单击添加后的命令，点击“重命名”，可以为命令修改名字和图标。

此处根据个人喜好修改即可，对于系统内置功能，其实不必修改，对于个人添加宏，建议修改名称及图标，否则会很丑。

5、完成上述步骤后，点击“确定 ”，即可看到刚刚新生成的选项卡。

以下为详细代码：

Sub getCellsInfo()
Dim selectedWS As Worksheet
Dim selectedRange As Range
Dim dataObj As Object
Dim Arr As Variant
Dim mAccount, loopRow, loopColumn As Long
Dim selectedStr As String
Dim maxLenArr() As Variant
'On Error Resume Next
Set selectedWS = Selection.Parent
With selectedWS
'selectedRange = Selection
mAccount = Selection.Cells.Count
If mAccount = 1 Then '避免只有一个单元格时无法直接复制为数组导致报错
ReDim Arr(1 To 1, 1 To 1)
Arr(1, 1) = Selection
Else
Arr = Selection
End If
If UBound(Arr, 1) = 1 And UBound(Arr, 2) = 1 Then '行跟列都只有1，的情况下，数据直接选择单元格内容
selectedStr = Arr(1, 1)
Else
ReDim maxLenArr(1 To UBound(Arr, 2)) '存储每列最大字符串长度
For loopColumn = 1 To UBound(Arr, 2)
maxLenArr(loopColumn) = Len(Arr(1, loopColumn)) + 2
For loopRow = 1 To UBound(Arr, 1) '对当前单元格文本内容后面附加空格，直至其达到本列最大字符串长度
If Len(Arr(loopRow, loopColumn)) + 2 > maxLenArr(loopColumn) Then maxLenArr(loopColumn) = Len(Arr(loopRow, loopColumn)) + 2
Next loopRow
Next loopColumn
selectedStr = ""
For loopRow = 1 To UBound(Arr, 1) '完成前述对齐步骤后，将数组转置为单一字符串
For loopColumn = 1 To UBound(Arr, 2)
selectedStr = selectedStr & Arr(loopRow, loopColumn) & creatSpaceByNum(maxLenArr(loopColumn) - Len(Arr(loopRow, loopColumn)))
Next loopColumn
selectedStr = selectedStr & vbNewLine
Next loopRow
End If
Set dataObj = New DataObject
dataObj.SetText selectedStr '要写入的文本
dataObj.PutInClipboard
Set dataObj = Nothing
End With
End Sub