如何使用富文本格式复制Excel单元格而不是全局单元格格式?

时间:2013-06-07 18:47:08

标签: excel vba

使用VBA,我将一个单元格的值复制到另一个单元格:

Dim s As Range
Dim d As Range
Set s = Range("A1")
Set d = Range("B2")
d.Value = s.Value

这样可以正常工作,但如果源包含富文本格式,则格式化将丢失。

我可以复制整个单元格,格式和所有:

s.Copy d

但这不仅带来了富文本格式,还带来了单元格上的全局格式 - 背景颜色,边框等。我只对复制适用于的格式感兴趣文本的一部分(例如,句子中的一个单词以粗体显示)。

我也尝试过复制每个角色的格式:

For ci = 1 to Len(sourcevalue)
   d.Characters(ci, 1).Font.Bold = s.Characters(ci, 1).Font.Bold
Next

上面的实际代码包括斜体,下划线等,并将Characters()缓存为速度对象,但是,对于生产使用,性能方式太慢。

我能想到的最后一个选项是复制带有格式的单元格,然后撤消对背景颜色或图案,边框,字体名称/大小等的任何更改:

bg = d.Interior.ColorIndex
s.Copy d
d.Interior.ColorIndex = bg

这看起来仍然很糟糕,很难保存所有要重新应用的格式,而且我无法“撤消”格式,如粗体,斜体等,可以应用于单元格或字符级别不删除字符级设置。

还有其他选择吗? Excel OpenOfficeXML文件中的格式存储有字符范围,但不会出现这些格式化的范围可通过API获得,至少就我所能找到而言。

编辑:使用下面的KazJaw方法,我可以通过以下代码获得所需内容:

Dim TmpFormat As Range
Set TmpFormat = Range("$XFD$1")
Dest.Copy
TmpFormat.PasteSpecial xlPasteFormats
Source.Copy
Dest.PasteSpecial xlPasteAll
TmpFormat.Copy
Dest.PasteSpecial xlPasteFormats
Dest.Font.Name = TmpFormat.Font.Name
Dest.Font.Size = TmpFormat.Font.Size
TmpFormat.ClearFormats

这暂时保留了我的目标单元格在第一行的最后一个单元格中的单元格格式,使用所有格式复制源,在临时单元格中粘贴返回格式,最后还复制回来保留的整体字体和大小(在我的情况下,我不想从源代码复制)。最后,临时单元格被清除,因此不会影响工作表的尺寸。

这是一个不完美的解决方案,特别是因为它依赖于剪贴板,但性能很好,它可以做它需要做的事情。

2 个答案:

答案 0 :(得分:4)

我刚刚进行了一些测试,我对结果感到有些惊讶,这些结果可能是您的解决方案,或者只是一个探索它的提示。

想象一下,我们在开始时遇到这种情况:

enter image description here

如果你运行这个简单的代码:...

Sub PossibleSolution()

    Range("A1").Copy     'full formatted cell
    Range("A3").PasteSpecial xlPasteAll
    Range("A2").Copy     'clear format cell
    Range("A3").PasteSpecial xlPasteFormats

End Sub

...您将得到以下结果:

enter image description here

答案 1 :(得分:2)

Range.Value有一个可选的RangeValueDataType参数(11是xlRangeValueXMLSpreadsheet):

 Range("B2").Value(11) = Range("A1").Value(11)